000100 IDENTIFICATION DIVISION.                                         00010000
000200 PROGRAM-ID.      HHCAL10D.                                       00020000
000300*AUTHOR.          DDS TEAM.                                       00030000
000400*REVISED.         DDS TEAM.                                       00031000
000500*REMARKS.     (CENTERS FOR MEDICARE & MEDICAID SERVICES)          00032000
000600*REMARKS. A). NATIONAL HHA PRICER                                 00033000
000700***       B). NATIONAL HHA PRICER EFFECTIVE OCT 1 2001            00034000
000800***       C). THERE ARE YEARLY HHA PRICER MODULES THAT WILL       00035000
000900***           CALCULATE THE HRG'S,REVENUE CODES AND               00036000
001000***           TYPE OF BILLS.                                      00037000
001100*REMARKS.                                                         00038000
001200******************************************************************00039000
001300*     FOR FY 2009 CALCULATIONS AND RATES NO CHANGES JUST SYNC TO  00164100
001400*              CORRECT LUPA RATE DETERMINATION IF LOGIC           00164200
001500*                CORRECT LUPA CALCULATION FOR REJECTED AND
001600*                REPROCESSED CLAIMS
001700*     HHCAL090 RATES EFFECTIVE JAN 1, 2009 CICS VERSION           00164300
001800*     HHCAL091 LUPA PAYMENT TO ZERO FOR ZERO REV VISITS           00164300
001900*     HHCAL092 HIPPA RECODE REVISION FOR 5 IN POS 1               00164300
002000*     HHCAL100 EXPAND BILLING RECORD TO 500 BYTES                       00
002100*     HHCAL101                                                          00
002200*     HHCAL106 CORRECT HIPSS RECODING LOGIC                             00
002300*     HHCAL10C INCREASE PROV-PAYMET-TOTAL TO  PIC 9(09)V9(02)
002310*     HHCAL10D ADD NEW FIELDS FOR EARLIEST DATES
002400******************************************************************00164400
002410*----------------------------------------------------------------*
002420* 2016 - ADDED 32Q AND 33Q AS VALID TOB CODES IN PARAGRAPH       *
002430*        400-CALC-THE-HHA                                        *
002440*----------------------------------------------------------------*
002500******************************************************************00164500
002600*            RETURN CODE VALUES (HHA-RTC)                         00164600
002700*                                                                 00164700
002800*        HHA-RTC  WITH PAYMENTS RETURNED                          00164800
002900*                                                                 00164900
003000*     RETURN CODES                                                00165000
003100*          00 = FINAL PAYMENT                                     00166000
003200*               TOB = 329,339,327,337                             00167000
003210*                  OR 32Q OR 33Q
003300*                  OR 32G OR 33G OR 32I OR 33I                    00168000
003400*                  OR 32J OR 33J OR 32M OR 33M                    00169000
003500*                  OR 32F OR 32K OR 32P OR 32H                    00170000
003600*                  OR 33F OR 33K OR 33P OR 33H                    00180000
003700*               WITH HRG,REVENUE CODE WHERE NO OUTLIER APPLIES    00190000
003800*          01 = FINAL PAYMENT                                     00200000
003900*               TOB = 329,339,327,337                             00210000
003910*                  OR 32Q OR 33Q
004000*                  OR 32G OR 33G OR 32I OR 33I                    00220000
004100*                  OR 32J OR 33J OR 32M OR 33M                    00230000
004200*                  OR 32F OR 32K OR 32P OR 32H                    00240000
004300*                  OR 33F OR 33K OR 33P OR 33H                    00250000
004400*               WITH HRG,REVENUE CODE WHERE OUTLIER APPLIES       00260000
004500*          03 = INITIAL HALF PAYMENT PAYMENT WILL BE ZERO         00270000
004600*               TOB = 332 AND 322                                 00280000
004700*          04 = INITIAL HALF PAYMENT PAID AT 50%                  00290000
004800*               TOB = 332 AND 322                                 00300000
004900*               WITH INITIAL (FIRST) HRG AND NO REVENUE CODES     00310000
005000*          05 = INITIAL HALF PAYMENT PAID AT 60%                  00320000
005100*               TOB = 332 AND 322                                 00330000
005200*               WITH INITIAL (FIRST) HRG AND NO REVENUE CODES     00340000
005300*       06,14 = LUPA PAYMENT ONLY                                 00350000
005400*               TOB = 329,339,327,337                             00360000
005410*                  OR 32Q OR 33Q
005500*                  OR 32G OR 33G OR 32I OR 33I                    00370000
005600*                  OR 32J OR 33J OR 32M OR 33M                    00380000
005700*                  OR 32F OR 32K OR 32P OR 32H                    00390000
005800*                  OR 33F OR 33K OR 33P OR 33H                    00400000
005900*               WITH REVENUE CODES AND REVENUE QTYS < 5       *   00410000
006000******************************************************************00420000
006100*          07 = FINAL PAYMENT, SCIC, PEP = N, NO OUTLIER          00430000
006200*               TOB = 329,339,327,337                             00440000
006210*                  OR 32Q OR 33Q
006300*                  OR 32G OR 33G OR 32I OR 33I                    00450000
006400*                  OR 32J OR 33J OR 32M OR 33M                    00460000
006500*                  OR 32F OR 32K OR 32P OR 32H                    00470000
006600*                  OR 33F OR 33K OR 33P OR 33H                    00480000
006700*               WITH REVENUE CODE WHERE NO OUTLIER APPLIES        00490000
006800*               WITH MORE THAN ONE HRG OCCURRENCE             *   00500000
006900*          08 = FINAL PAYMENT, SCIC, PEP = N, WITH OUTLIER        00510000
007000*               TOB = 329,339,327,337                             00520000
007010*                  OR 32Q OR 33Q
007100*                  OR 32G OR 33G OR 32I OR 33I                    00530000
007200*                  OR 32J OR 33J OR 32M OR 33M                    00540000
007300*                  OR 32F OR 32K OR 32P OR 32H                    00550000
007400*                  OR 33F OR 33K OR 33P OR 33H                    00560000
007500*               WITH REVENUE CODE WHERE OUTLIER APPLIES           00570000
007600*               WITH MORE THAN ONE HRG OCCURRENCE             *   00580000
007700******************************************************************00590000
007800*          09 = FINAL PAYMENT, PEP = Y, NO OUTLIER                00600000
007900*               TOB = 329,339,327,337                             00610000
007910*                  OR 32Q OR 33Q
008000*                  OR 32G OR 33G OR 32I OR 33I                    00620000
008100*                  OR 32J OR 33J OR 32M OR 33M                    00630000
008200*                  OR 32F OR 32K OR 32P OR 32H                    00640000
008300*                  OR 33F OR 33K OR 33P OR 33H                    00650000
008400*               WITH REVENUE CODE WHERE NO OUTLIER APPLIES        00660000
008500*               WITH ONE HRG OCCURRENCE                       *   00670000
008600*          11 = FINAL PAYMENT, PEP = Y, WITH OUTLIER              00680000
008700*               TOB = 329,339,327,337                             00690000
008710*                  OR 32Q OR 33Q
008800*                  OR 32G OR 33G OR 32I OR 33I                    00700000
008900*                  OR 32J OR 33J OR 32M OR 33M                    00710000
009000*                  OR 32F OR 32K OR 32P OR 32H                    00720000
009100*                  OR 33F OR 33K OR 33P OR 33H                    00730000
009200*               WITH REVENUE CODE WHERE OUTLIER APPLIES           00740000
009300*               WITH ONE HRG OCCURRENCE                       *   00750000
009400******************************************************************00760000
009500*          12 = FINAL PAYMENT, SCIC, PEP = Y, NO OUTLIER          00770000
009600*               TOB = 329,339,327,337                             00780000
009610*                  OR 32Q OR 33Q
009700*                  OR 32G OR 33G OR 32I OR 33I                    00790000
009800*                  OR 32J OR 33J OR 32M OR 33M                    00800000
009900*                  OR 32F OR 32K OR 32P OR 32H                    00810000
010000*                  OR 33F OR 33K OR 33P OR 33H                    00820000
010100*               WITH REVENUE CODE WHERE NO OUTLIER APPLIES        00830000
010200*               WITH MORE THAN ONE HRG OCCURRENCE             *   00840000
010300*          13 = FINAL PAYMENT, SCIC, PEP = Y, WITH OUTLIER        00850000
010400*               TOB = 329,339,327,337                             00860000
010410*                  OR 32Q OR 33Q
010500*                  OR 32G OR 33G OR 32I OR 33I                    00870000
010600*                  OR 32J OR 33J OR 32M OR 33M                    00880000
010700*                  OR 32F OR 32K OR 32P OR 32H                    00890000
010800*                  OR 33F OR 33K OR 33P OR 33H                    00900000
010900*               WITH REVENUE CODE WHERE OUTLIER APPLIES           00910000
011000*               WITH MORE THAN ONE HRG OCCURRENCE             *   00920000
011100******************************************************************00930000
011200******************************************************************00940000
011300*                                                             *   00950000
011400*            HHA-RTC   NO PAYMENTS RETURNED                   *   00960000
011500*                                                             *   00970000
011600*              10 = INVALID TOB                               *   00980000
011700*                                                             *   00990000
011800*              15 = INVALID PEP DAYS                          *   01000000
011900*                   FOR SHORTENED EPISODE                     *   01010000
012000*                                                             *   01020000
012100*              16 = INVALID HRG DAYS , > 60 DAYS              *   01030000
012200*                                                             *   01040000
012300*              20 = INVALID PEP INDICATOR                     *   01050000
012400*                                                             *   01060000
012500*              25 = INVALID MED REVIEW INDICATOR              *   01070000
012600*                                                             *   01080000
012700*              30 = INVALID CBSA CODE                         *   01090000
012800*                                                             *   01100000
012900*              35 = INVALID INITIAL PAYMENT INDICATOR         *   01110000
013000*                        0 = MAKE NORMAL INITIAL PAYMENT      *   01120000
013100*                        1 = MAKE ZERO PAYMANT                *   01130000
013200*                                                             *   01140000
013300*              40 = INVALID SERVICE THRU DATE FOR             *   01150000
013400*                      CURRENT CALENDER YEAR                  *   01160000
013500*                                                             *   01170000
013600*              70 = INVALID OR NO HRG CODE PRESENT            *   01180000
013700*                                                             *   01190000
013800*              75 = NO HRG PRESENT IN FIRST OCCURANCE AND     *   01200000
013900*                   REVENUE-QTY-COV-VISITS > 4  AND           *   01210000
014000*                       TOB = 329,339,327,337                 *   01220000
014100*                          OR 32G OR 33G OR 32I OR 33I        *   01230000
014200*                          OR 32J OR 33J OR 32M OR 33M        *   01240000
014300*                          OR 32F OR 32K OR 32P OR 32H            01250000
014400*                          OR 33F OR 33K OR 33P OR 33H            01260000
014500*                                                             *   01270000
014600*              80 = INVALID REVENUE CODE                      *   01280000
014700*                                                             *   01290000
014800*              85 = NO REVENUE CODE PRESENT                   *   01300000
014900*                   WITH TOB 329 OR 339 OR 327 OR 337         *   01310000
015000*                         OR 32G OR 33G OR 32I OR 33I         *   01320000
015100*                         OR 32J OR 33J OR 32M OR 33M         *   01330000
015200*                         OR 32F OR 32K OR 32P OR 32H             01340000
015300*                         OR 33F OR 33K OR 33P OR 33H             01350000
015400*                                                             *   01360000
015500***************************************************************   01370000
015600***************************************************************   01380000
015700***************************************************************   01390000
015800 DATE-COMPILED.                                                   01400000
015900 ENVIRONMENT DIVISION.                                            01410000
016000 CONFIGURATION SECTION.                                           01420000
016100 SOURCE-COMPUTER.            IBM-370.                             01430000
016200 OBJECT-COMPUTER.            IBM-370.                             01440000
016300 INPUT-OUTPUT  SECTION.                                           01450000
016400 FILE-CONTROL.                                                    01460000
016500                                                                  01470000
016600 DATA DIVISION.                                                   01480000
016700 FILE SECTION.                                                    01490000
016800                                                                  01500000
016900 WORKING-STORAGE SECTION.                                         01510000
017000 01  W-STORAGE-REF                  PIC X(46)  VALUE              01520000
017100     'HHCAL10D       - W O R K I N G   S T O R A G E'.            01530000
017200 01  CAL-VERSION                    PIC X(07)  VALUE 'C2010.D'.   01540000
017300 01  CO1                            PIC S9(04) COMP SYNC.         01550000
017400 01  SUB1                           PIC S9(04) COMP SYNC.         01560000
017500 01  R1                             PIC S9(04) COMP SYNC.         01570000
017600 01  R2                             PIC S9(04) COMP SYNC.         01580000
017700 01  R3                             PIC S9(04) COMP SYNC.         01590000
017800                                                                  01600000
017900 01  LABOR-NLABOR-PERCENT.                                        01610000
018000     05 LABOR-PERCENT        PIC 9V9(05)  VALUE 0.77082.          01620004
018100     05 NONLABOR-PERCENT     PIC 9V9(05)  VALUE 0.22918.          01630004
018200                                                                  01640000
018300***************************************************************   04500005
018400*         YEARCHANGE                              ===========**   04500005
018500***************************************************************   04500005
018600 01  LUPA-ADD-ON                  PIC 9(03)V9(02) VALUE 094.72.   01650000
018700 01  LUPA-ADD-ON-2PERCENT         PIC 9(03)V9(02) VALUE 092.86.   01650000
018800 01  LUPA-LABOR-ADJ               PIC 9(03)V9(02).                01650000
018900 01  LUPA-NON-LABOR-ADJ           PIC 9(03)V9(02).                01650000
019000                                                                  01640000
019100 01  FED-EPISODE-RATE-AMT         PIC 9(05)V9(02) VALUE 0.        01650000
019200 01  OUTLIER-THRESHOLD-AMT        PIC 9(05)V9(02) VALUE 0.        01660000
019300***************************************************************** 01670000
019400***    EXAMPLE    *********************************************** 01680000
019500*** FED-EPISODE-RATE-AMT TIMES 1.13 = OUTLIER-THRESHOLD-AMT ***** 01690000
019600******  2327.68 TIMES 0.65  = 1512.99  ROUNDED UP  ************** 01700000
019700***************************************************************** 01710000
019800 01  OUTL-LOSS-SHAR-RATIO-PERCENT PIC 9(01)V9(02) VALUE 0.80.     01720000
019900                                                                  01730000
020000 01  WK-PEP-DAYS           PIC S9(04)       VALUE 0.              01740000
020100 01  WK-HRG-NO-OF-DAYS     PIC S9(04)       VALUE 0.              01750000
020200 01  WK-HRG-NO-OF-DAYS-FAC PIC S9(04)V9(06) VALUE 0.              01750000
020300 01  WK-HRG-NO-OF-DAYS-TOT PIC S9(04)       VALUE 0.              01760000
020400 01  WK-RTC-ADJ-IND        PIC 9            VALUE 0.              01770000
020500 01  WK-ALL-TOTALS.                                               01780000
020600     05  FED-ADJ                        PIC S9(07)V9(02).         01790000
020700     05  FED-ADJ1                       PIC S9(07)V9(02).         01800000
020800     05  FED-LABOR-ADJ                  PIC S9(07)V9(02).         01810000
020900     05  FED-SUPPLY-ADJ                 PIC S9(07)V9(02).         01811005
021000     05  FED-NON-LABOR-ADJ              PIC S9(07)V9(02).         01820005
021100     05  OUT-THRES-AMT-ADJ              PIC S9(07)V9(02).         01830005
021200     05  OUT-THRES-LABOR-ADJ            PIC S9(07)V9(02).         01840005
021300     05  OUT-THRES-NON-LABOR-ADJ        PIC S9(07)V9(02).         01850005
021400     05  WK-3000-PEP-N-PRETOT-PAY       PIC S9(07)V9(02).         01860005
021500     05  WK-3000-PEP-N-PAYMENT          PIC S9(07)V9(02).         01870005
021600     05  WK-4000-PEP-Y-PRETOT-PAY       PIC S9(07)V9(02).         01880005
021700     05  WK-4000-PEP-Y-PAYMENT          PIC S9(07)V9(02).         01890005
021800     05  WK-5000-PEP-N-PRETOT-PAY       PIC S9(07)V9(02).         01900005
021900     05  WK-5000-PEP-N-PAYMENT          PIC S9(07)V9(02).         01910005
022000     05  WK-6000-PEP-Y-PRETOT-PAY       PIC S9(07)V9(02).         01920005
022100     05  WK-6000-PEP-Y-PAYMENT          PIC S9(07)V9(02).         01930005
022200     05  WK-6050-PEP-Y-TOT-DAYS         PIC S9(04).               01940005
022300     05  WK-7000-OUTLIER-VALUE-A        PIC S9(07)V9(02).         01950005
022400     05  WK-7000-AB-DIFF                PIC S9(07)V9(02).         01960005
022500     05  WK-7000-CALC                   PIC S9(07)V9(02).         01970005
022600     05  WK-8000-OUTLIER-VALUE-B        PIC S9(07)V9(02).         01980005
022700     05  WK-8000-OUTLIER-LAB-NLAB       PIC S9(07)V9(02).         01990005
022800     05  WK-10000-OUTLIER-POOL-DIF      PIC S9(07)V9(02).         01990005
022900     05  WK-10000-OUTLIER-POOL-PERCENT  PIC S9(09)V9(02).         01990005
023000     05  WK-10000-OUTLIER-AVAIL-POOL    PIC S9(09)V9(02).         01990005
023100                                                                  02000005
023200 01  WORK-HRG.                                                    02001006
023300     05  WORK-HRG1                      PIC X(01).                02002006
023400     05  WORK-HRG2                      PIC X(01).                02003006
023500     05  WORK-HRG3                      PIC X(01).                02004006
023600     05  WORK-HRG4                      PIC X(01).                02005006
023700     05  WORK-HRG5                      PIC X(01).                02006006
023800                                                                  02010005
023900                                                                  02020005
024000*******************************************************           02030005
024100 01  HOLD-HHA-DATA.                                               02040005
024200     05  H-HHA-INPUT-DATA.                                        02050005
024300         10  H-HHA-NPI                 PIC X(10).                 02060005
024400         10  H-HHA-HIC                 PIC X(12).                 02070005
024500         10  H-HHA-PROV-NO             PIC X(06).                 02080005
024600         10  H-HHA-TOB                 PIC XXX.                   02090005
024700         10  H-HHA-PEP-INDICATOR       PIC X.                     02100005
024800         10  H-HHA-PEP-DAYS            PIC 999.                   02110005
024900         10  H-HHA-INIT-PAY-INDICATOR  PIC X.                     02120005
025000             88 H-HHA-WITH-DATA-CHECK VALUE '0', '1'.             02130005
025100             88 H-HHA-NO-DATA-CHECK   VALUE '2', '3'.             02140005
025200         10  FILLER                    PIC X(07).                 02150005
025300         10  H-HHA-MSA1                PIC 9(07)V9(02).           02160005
025400         10  H-HHA-MSA2-DATA REDEFINES H-HHA-MSA1.                02170005
025500             15  FILLER             PIC XXX.                      02180005
025600             15  H-HHA-MSA2         PIC XXXX.                     02190005
025700             15  FILLER             PIC XX.                       02200005
025800         10  H-HHA-CBSA-DATA REDEFINES H-HHA-MSA1.                02210005
025900             15  FILLER             PIC XX.                       02220005
026000             15  H-HHA-CBSA         PIC XXXXX.                    02230005
026100             15  FILLER             PIC XX.                       02240005
026200         10  H-HHA-SERV-FROM-DATE.                                02250005
026300             15  H-HHA-FROM-CC         PIC XX.                    02260005
026400             15  H-HHA-FROM-YYMMDD.                               02270005
026500                 25  H-HHA-FROM-YY     PIC XX.                    02280005
026600                 25  H-HHA-FROM-MM     PIC XX.                    02290005
026700                 25  H-HHA-FROM-DD     PIC XX.                    02300005
026800         10  H-HHA-SERV-THRU-DATE.                                02310005
026900             15  H-HHA-THRU-CC         PIC XX.                    02320005
027000             15  H-HHA-THRU-YYMMDD.                               02330005
027100                 25  H-HHA-THRU-YY     PIC XX.                    02340005
027200                 25  H-HHA-THRU-MM     PIC XX.                    02350005
027300                 25  H-HHA-THRU-DD     PIC XX.                    02360005
027400         10  H-HHA-ADMIT-DATE.                                    02370005
027500             15  H-HHA-ADMIT-CC        PIC XX.                    02380005
027600             15  H-HHA-ADMIT-YYMMDD.                              02390005
027700                 25  H-HHA-ADMIT-YY    PIC XX.                    02400005
027800                 25  H-HHA-ADMIT-MM    PIC XX.                    02410005
027900                 25  H-HHA-ADMIT-DD    PIC XX.                    02420005
028000         10  H-HHA-HRG-DATA      OCCURS 6.                        02430005
028100             15  H-HHA-MED-REVIEW-INDICATOR PIC X.                02440005
028200             15  H-HHA-HRG-INPUT-CODE       PIC X(05).            02450005
028300             15  H-HHA-HRG-OUTPUT-CODE      PIC X(05).            02460005
028400             15  H-HHA-HRG-NO-OF-DAYS       PIC 9(03).            02470005
028500             15  H-HHA-HRG-WGTS             PIC 9(02)V9(04).      02480005
028600             15  H-HHA-HRG-PAY              PIC 9(07)V9(02).      02490005
028700         10  H-HHA-REVENUE-DATA     OCCURS 6.                     02500005
028800             15  H-HHA-REVENUE-CODE             PIC X(04).        02510005
028900             15  H-HHA-REVENUE-QTY-COV-VISITS   PIC 9(03).        02520005
028910             15  H-HHA-REVENUE-EARLIEST-DATE    PIC 9(08).        00471010
029000             15  H-HHA-REVENUE-DOLL-RATE        PIC 9(07)V9(02).  02530005
029100             15  H-HHA-REVENUE-COST             PIC 9(07)V9(02).  02540005
029110             15  H-HHA-REVENUE-ADD-ON-VISIT-AMT PIC 9(07)V9(02).  00491007
029200     05  H-HHA-PASSBACK-DATA.                                     02550005
029300         10  H-HHA-PAY-RTC                PIC 99.                 02560005
029400         10  H-HHA-REVENUE-SUM1-3-QTY-THR PIC 9(05).              02570005
029500         10  H-HHA-REVENUE-SUM1-6-QTY-ALL PIC 9(05).              02580005
029600         10  H-HHA-OUTLIER-PAYMENT        PIC 9(07)V9(02).        02590005
029700         10  H-HHA-TOTAL-PAYMENT          PIC 9(07)V9(02).        02600005
029800     05  H-HHA-CASE-MIX-DATA.                                     02601005
029900         10  H-HHA-LUPA-ADD-ON-PAYMENT    PIC 9(03)V9(02).        02602005
030000         10  H-HHA-LUPA-SRC-ADM           PIC X.                  02603005
030100         10  H-HHA-RECODE-IND             PIC X.                  02604005
030200         10  H-HHA-EPISODE-TIMING         PIC 9.                  02605005
030300         10  H-HHA-SEVERITY-POINTS.                               02606005
030400             15  H-HHA-CLINICAL-SEV-EQ1   PIC X(01).              02607005
030500             15  H-HHA-FUNCTION-SEV-EQ1   PIC X(01).              02608005
030600             15  H-HHA-CLINICAL-SEV-EQ2   PIC X(01).              02609005
030700             15  H-HHA-FUNCTION-SEV-EQ2   PIC X(01).              02609105
030800             15  H-HHA-CLINICAL-SEV-EQ3   PIC X(01).              02609205
030900             15  H-HHA-FUNCTION-SEV-EQ3   PIC X(01).              02609305
031000             15  H-HHA-CLINICAL-SEV-EQ4   PIC X(01).              02609405
031100             15  H-HHA-FUNCTION-SEV-EQ4   PIC X(01).              02609505
031200     05  H-HHA-PROV-TOTAL-DATA.                                   00010000
031300         10  H-HHA-PROV-OUTLIER-PAY-TOTAL PIC 9(08)V9(02).        00020000
031400         10  H-HHA-PROV-PAYMET-TOTAL      PIC 9(09)V9(02).        00030000
031500     05  FILLER                           PIC X(33).              00040000
031600**==================================================***           02609705
031700*    05  FILLER                         PIC X(20).                02610005
031800**==================================================***           02611005
031900                                                                  02640005
032000 LINKAGE SECTION.                                                 02650005
032100***************************************************************   02660005
032200*                 * * * * * * * * *                           *   02670005
032300***************************************************************   02680005
032400***************************************************************   02690005
032500*    THIS DATA IS CALCULATED BY THIS HHAPR  SUBROUTINE        *   02700005
032600*    AND PASSED BACK TO THE CALLING PROGRAM                   *   02710005
032700***************************************************************   02720005
032800 01  HHA-INPUT-DATA.                                              02730005
032900     05  HHA-DATA.                                                02740005
033000         10  HHA-NPI                 PIC X(10).                   02750005
033100         10  HHA-HIC                 PIC X(12).                   02760005
033200         10  HHA-PROV-NO             PIC X(06).                   02770005
033300         10  HHA-TOB                 PIC XXX.                     02780005
033400         10  HHA-PEP-INDICATOR       PIC X.                       02790005
033500         10  HHA-PEP-DAYS            PIC 999.                     02800005
033600         10  HHA-INIT-PAY-INDICATOR  PIC X.                       02810005
033700             88  HHA-WITH-DATA-CHECK VALUE '0', '1'.              02820005
033800             88  HHA-NO-DATA-CHECK   VALUE '2', '3'.              02830005
033900         10  FILLER                  PIC X(07).                   02840005
034000         10  HHA-MSA1                PIC 9(07)V9(02).             02850005
034100         10  HHA-MSA2-DATA REDEFINES HHA-MSA1.                    02860005
034200             15  FILLER             PIC XXX.                      02870005
034300             15  HHA-MSA2.                                        02880005
034400                 25  HHA-MSA2-RURAL-1ST.                          02890005
034500                     30  HHA-RURAL-MSA         PIC XX.            02900005
034600                     88  HHA-MSA-RURAL-CHECK   VALUE '99'.        02910005
034700                 25  HHA-MSA2-RURAL-2ND        PIC XX.            02920005
034800             15  FILLER             PIC XX.                       02930005
034900         10  HHA-CBSA-DATA REDEFINES HHA-MSA1.                    02940005
035000             15  FILLER             PIC XX.                       02950005
035100             15  HHA-CBSA.                                        02960005
035200                 88  HHA-CBSA-RURAL-CHECK-ALL VALUE               02970005
035300                 '50001', '50007', '50016', '50020', '50031',     02980005
035400                 '50036', '50054', '50060', '50067', '50087',     02990005
035500                 '50089', '50091', '50092', '50100', '50104',     03000005
035600                 '50108', '50114', '50121', '50125', '50140',     03010005
035700                 '50145', '50152', '50164', '50170', '50199',     03020005
035800                 '50206', '50210', '50214', '50218', '50222',     03021005
035900                 '50225', '50226', '50231', '50234', '50237',     03022005
036000                 '50243', '50248', '50250', '50255', '50256',     03023005
036100                 '50257', '50260', '50261', '50262', '50266',     03024005
036200                 '50268', '50272', '50275', '50281', '50286',     03025005
036300                 '50313', '50314', '50316', '50325', '50326',     03026005
036400                 '50327', '50329', '50336', '50344', '50352',     03027005
036500                 '50192', '50263', '50293'.                       03028005
036600                 25  HHA-CBSA-RURAL-1ST.                          03029005
036700                     30  HHA-RURAL-CBSA        PIC XXX.           03029105
036800                     88  HHA-CBSA-RURAL-CHECK   VALUE '999'.      03029205
036900                 25  HHA-CBSA-RURAL-2ND        PIC XX.            03029305
037000             15  FILLER             PIC XX.                       03029405
037100         10  HHA-SERV-FROM-DATE.                                  03029505
037200             15  HHA-FROM-CC         PIC XX.                      03029605
037300             15  HHA-FROM-YYMMDD.                                 03029705
037400                 25  HHA-FROM-YY     PIC XX.                      03029805
037500                 25  HHA-FROM-MM     PIC XX.                      03029905
037600                 25  HHA-FROM-DD     PIC XX.                      03030005
037700         10  HHA-SERV-THRU-DATE.                                  03040005
037800             15  HHA-THRU-CC         PIC XX.                      03050005
037900             15  HHA-THRU-YYMMDD.                                 03060005
038000                 25  HHA-THRU-YY     PIC XX.                      03070005
038100                 25  HHA-THRU-MM     PIC XX.                      03080005
038200                 25  HHA-THRU-DD     PIC XX.                      03090005
038300         10  HHA-ADMIT-DATE.                                      03100005
038400             15  HHA-ADMIT-CC        PIC XX.                      03110005
038500             15  HHA-ADMIT-YYMMDD.                                03120005
038600                 25  HHA-ADMIT-YY    PIC XX.                      03130005
038700                 25  HHA-ADMIT-MM    PIC XX.                      03140005
038800                 25  HHA-ADMIT-DD    PIC XX.                      03150005
038900         10  HHA-HRG-DATA      OCCURS 6.                          03160005
039000             15  HHA-MED-REVIEW-INDICATOR PIC X.                  03170005
039100             15  HHA-HRG-INPUT-CODE       PIC X(05).              03180005
039200             15  HHA-HRG-OUTPUT-CODE      PIC X(05).              03190005
039300             15  HHA-HRG-NO-OF-DAYS       PIC 9(03).              03200005
039400             15  HHA-HRG-WGTS             PIC 9(02)V9(04).        03210005
039500             15  HHA-HRG-PAY              PIC 9(07)V9(02).        03220005
039600         10  HHA-REVENUE-DATA     OCCURS 6.                       03230005
039700             15  HHA-REVENUE-CODE             PIC X(04).          03240005
039800             15  HHA-REVENUE-QTY-COV-VISITS   PIC 9(03).          03250005
039810             15  HHA-REVENUE-EARLIEST-DATE    PIC 9(08).          00471010
039900             15  HHA-REVENUE-DOLL-RATE        PIC 9(07)V9(02).    03260005
040000             15  HHA-REVENUE-COST             PIC 9(07)V9(02).    03270005
040010             15  HHA-REVENUE-ADD-ON-VISIT-AMT PIC 9(07)V9(02).    00491007
040100     05  HHA-PASSBACK-DATA.                                       03280005
040200         10  HHA-PAY-RTC                PIC 99.                   03290005
040300         10  HHA-REVENUE-SUM1-3-QTY-THR PIC 9(05).                03300005
040400         10  HHA-REVENUE-SUM1-6-QTY-ALL PIC 9(05).                03310005
040500         10  HHA-OUTLIER-PAYMENT        PIC 9(07)V9(02).          03320005
040600         10  HHA-TOTAL-PAYMENT          PIC 9(07)V9(02).          03330005
040700     05  HHA-CASE-MIX-DATA.                                       02601005
040800         10  HHA-LUPA-ADD-ON-PAYMENT      PIC 9(03)V9(02).        02602005
040900         10  HHA-LUPA-SRC-ADM             PIC X.                  02603005
041000         10  HHA-RECODE-IND               PIC X.                  02604005
041100         10  HHA-EPISODE-TIMING           PIC 9.                  02605005
041200         10  HHA-SEVERITY-POINTS.                                 02606005
041300             15  HHA-CLINICAL-SEV-EQ1     PIC X(01).              02607005
041400             15  HHA-FUNCTION-SEV-EQ1     PIC X(01).              02608005
041500             15  HHA-CLINICAL-SEV-EQ2     PIC X(01).              02609005
041600             15  HHA-FUNCTION-SEV-EQ2     PIC X(01).              02609105
041700             15  HHA-CLINICAL-SEV-EQ3     PIC X(01).              02609205
041800             15  HHA-FUNCTION-SEV-EQ3     PIC X(01).              02609305
041900             15  HHA-CLINICAL-SEV-EQ4     PIC X(01).              02609405
042000             15  HHA-FUNCTION-SEV-EQ4     PIC X(01).              02609505
042100     05  HHA-PROV-TOTAL-DATA.                                     00010000
042200         10  HHA-PROV-OUTLIER-PAY-TOTAL PIC 9(08)V9(02).          00020000
042300         10  HHA-PROV-PAYMET-TOTAL      PIC 9(09)V9(02).          00030000
042400     05  FILLER                         PIC X(33).                00040000
042500**==================================================***           02609705
042600*    05  FILLER                         PIC X(20).                03340005
042700                                                                  03350005
042800 01  HOLD-VARIABLES-DATA.                                         03360005
042900     02  HOLD-VAR-DATA.                                           03370005
043000         05  PRICER-OPTION-SW                   PIC X(01).        03380005
043100         05  HHOPN-VERSION                      PIC X(07).        03390005
043200         05  HHDRV-VERSION                      PIC X(07).        03400005
043300         05  HHCAL-VERSION                      PIC X(07).        03410005
043400         05  FILLER                             PIC X(20).        03420005
043500                                                                  03430005
043600 01  CBSA-WAGE-INDEX-DATA.                                        03440005
043700     02  HOLD-WIR-DATA.                                           03450005
043800         05  WIR-CBSA                       PIC X(05).            03460005
043900         05  WIR-CBSA-EFFDATE               PIC X(08).            03470005
044000         05  WIR-CBSA-WAGEIND               PIC 9(02)V9(04).      03480005
044100                                                                  03490005
044200 PROCEDURE DIVISION  USING HHA-INPUT-DATA                         03500005
044300                           HOLD-VARIABLES-DATA                    03510005
044400                           CBSA-WAGE-INDEX-DATA.                  03520005
044500                                                                  03530005
044600***************************************************************   03540005
044700*    PROCESSING:                                              *   03550005
044800*        A. WILL PROCESS NATIONAL HHA FOR CY 2010             *   03560005
044900*                STARTING JAN 1, 2010                         *   03570005
045000***************************************************************   03580005
045100                                                                  03590005
045200     MOVE CAL-VERSION TO HHCAL-VERSION.                           03600005
045300                                                                  03610005
045400     PERFORM 200-MAINLINE-CONTROL THRU 200-EXIT.                  03620005
045500                                                                  03630005
045600     MOVE HOLD-HHA-DATA TO HHA-INPUT-DATA.                        03640005
045700                                                                  03650005
045800     GOBACK.                                                      03660005
045900                                                                  03670005
046000 200-MAINLINE-CONTROL.                                            03680005
046100                                                                  03690005
046200     MOVE HHA-INPUT-DATA TO HOLD-HHA-DATA.                        03700005
046300                                                                  03710005
046400                                                                  03710005
046500*     DISPLAY '-- HHA-HIC HHCAL10D  ===> ' HHA-HIC.               03640000
046600                                                                  03710005
046700     MOVE ALL '0' TO                                              03720005
046800                     WK-ALL-TOTALS                                03730005
046900                     WK-HRG-NO-OF-DAYS                            03740005
047000                     WK-HRG-NO-OF-DAYS-TOT                        03750005
047100                     WK-RTC-ADJ-IND                               03760005
047200                     WK-PEP-DAYS                                  03770005
047300                     H-HHA-PASSBACK-DATA                          03780005
047400                     H-HHA-HRG-PAY (1)                            03790005
047500                     H-HHA-HRG-PAY (2)                            03800005
047600                     H-HHA-HRG-PAY (3)                            03810005
047700                     H-HHA-HRG-PAY (4)                            03820005
047800                     H-HHA-HRG-PAY (5)                            03830005
047900                     H-HHA-HRG-PAY (6)                            03840005
048000                     H-HHA-REVENUE-COST (1)                       03850005
048100                     H-HHA-REVENUE-COST (2)                       03860005
048200                     H-HHA-REVENUE-COST (3)                       03870005
048300                     H-HHA-REVENUE-COST (4)                       03880005
048400                     H-HHA-REVENUE-COST (5)                       03890005
048500                     H-HHA-REVENUE-COST (6).                      03900005
048600                                                                  03910005
048700     IF  H-HHA-PAY-RTC = 00                                       03920005
048800         PERFORM 400-CALC-THE-HHA THRU 400-EXIT.                  03930005
048900                                                                  03940005
049000 200-EXIT.   EXIT.                                                03950005
049100                                                                  03960005
049200 400-CALC-THE-HHA.                                                03970005
049300                                                                  03980005
049400*    IF H-HHA-SERV-THRU-DATE < 20070101                           03990005
049500*        MOVE '40' TO H-HHA-PAY-RTC                               04000005
049600*        GO TO 400-EXIT.                                          04010005
049700                                                                  04020005
049800     IF H-HHA-ADMIT-DATE >                                        04030005
049900        H-HHA-SERV-FROM-DATE                                      04040005
050000         MOVE '40' TO H-HHA-PAY-RTC                               04050005
050100         GO TO 400-EXIT.                                          04060005
050200                                                                  04070005
050300     IF ((H-HHA-TOB = '332' OR '322') AND                         04080005
050400        (H-HHA-HRG-INPUT-CODE (1) = SPACE))                       04090005
050500        MOVE '70' TO H-HHA-PAY-RTC                                04100005
050600        GO TO 400-EXIT.                                           04110005
050700                                                                  04120005
050800     IF ((H-HHA-TOB = '329' OR '339' OR '327' OR '337' OR         04130005
050810                      '32Q' OR '33Q' OR
050900                      '32G' OR '33G' OR '32I' OR '33I' OR         04140005
051000                      '32F' OR '32K' OR '32P' OR '32H' OR         04150005
051100                      '33F' OR '33K' OR '33P' OR '33H' OR         04160005
051200                      '32J' OR '33J' OR '32M' OR '33M') AND       04170005
051300         (H-HHA-REVENUE-SUM1-6-QTY-ALL > 4 ) AND                  04180005
051400         (H-HHA-HRG-INPUT-CODE (1) = SPACE))                      04190005
051500        MOVE '75' TO H-HHA-PAY-RTC                                04200005
051600        GO TO 400-EXIT.                                           04210005
051700                                                                  04220005
051800     IF ((H-HHA-TOB = '329' OR '339' OR '327' OR '337' OR         04230005
051810                      '32Q' OR '33Q' OR
051900                      '32G' OR '33G' OR '32I' OR '33I' OR         04240005
052000                      '32F' OR '32K' OR '32P' OR '32H' OR         04250005
052100                      '33F' OR '33K' OR '33P' OR '33H' OR         04260005
052200                      '32J' OR '33J' OR '32M' OR '33M') AND       04270005
052300         (H-HHA-REVENUE-CODE (1) = SPACE))                        04280005
052400        MOVE '85' TO H-HHA-PAY-RTC                                04290005
052500        GO TO 400-EXIT.                                           04300005
052600                                                                  04310005
052700     IF ((H-HHA-TOB = '329' OR '339' OR '327' OR '337' OR         04320005
052710                      '32Q' OR '33Q' OR
052800                      '32G' OR '33G' OR '32I' OR '33I' OR         04330005
052900                      '32F' OR '32K' OR '32P' OR '32H' OR         04340005
053000                      '33F' OR '33K' OR '33P' OR '33H' OR         04350005
053100                      '32J' OR '33J' OR '32M' OR '33M') AND       04360005
053200         (H-HHA-HRG-INPUT-CODE (2) NOT = SPACES) AND              04370005
053300         (H-HHA-PEP-INDICATOR = 'Y') AND                          04380005
053400         (H-HHA-PEP-DAYS NOT NUMERIC OR                           04390005
053500          H-HHA-PEP-DAYS = ZEROES))                               04400005
053600        MOVE '15' TO H-HHA-PAY-RTC                                04410005
053700        GO TO 400-EXIT.                                           04420005
053800                                                                  04430005
053900     IF H-HHA-PAY-RTC NOT = 00 GO TO 400-EXIT.                    04440005
054000                                                                  04450005
054100***************************************************************   04460005
054200***************************************************************   04470005
054300*        THESE RATES & THRESHOLDS ARE APPLIED                 *   04480005
054400* FOR NON-RURAL AND  RURAL                                    *   04490005
054500***************************************************************   04500005
054600*         YEARCHANGE                              ===========**   04500005
054700***************************************************************   04500005
054800* FOR NON RURAL RATES AND RURAL RATES                         *   04510005
054900     MOVE 02312.94 TO   FED-EPISODE-RATE-AMT.                     04520005
055000     MOVE 01549.67 TO   OUTLIER-THRESHOLD-AMT.                    04530005
055100                                                                  04540005
055200*------------------------------------------------------           04550005
055300* NO DATE SPAN AND WITH REPORTING DATA  ---------------           04560005
055400* DATE SPAN DOES NOT APPLY FOR CY 2009  ---------------           04560005
055500*         YEARCHANGE                              ===========**   04500005
055600*------------------------------------------------------           04570005
055700*    IF HHA-SERV-THRU-DATE > 20071231 AND                         04580005
055800*       HHA-SERV-FROM-DATE > 20071231                             04590005
055900        IF HHA-WITH-DATA-CHECK                                    04600005
056000           MOVE 02312.94 TO   FED-EPISODE-RATE-AMT                04610005
056100           MOVE 01549.67 TO   OUTLIER-THRESHOLD-AMT               04620005
056200        ELSE                                                      04630005
056300*------------------------------------------------------           04640005
056400* NO DATE SPAN AND NO   REPORTING DATA  ---------------           04640105
056500*         YEARCHANGE                              ===========**   04500005
056600*------------------------------------------------------           04640205
056700           MOVE 02267.59 TO   FED-EPISODE-RATE-AMT                04640305
056800           MOVE 01519.29 TO   OUTLIER-THRESHOLD-AMT               04640405
056900        END-IF                                                    04640505
057000*    ELSE                                                         04640605
057100*------------------------------------------------------           04640705
057200*    DATE SPAN, RURAL, AND WITH REPORTING DATA --------           04640805
057300*------------------------------------------------------           04640905
057400*       IF HHA-CBSA-RURAL-CHECK                                   04641005
057500*       OR HHA-CBSA-RURAL-CHECK-ALL                               04642005
057600*          IF HHA-WITH-DATA-CHECK                                 04643005
057700*             MOVE 02337.06 TO   FED-EPISODE-RATE-AMT             04644005
057800*             MOVE 02079.98 TO   OUTLIER-THRESHOLD-AMT            04645005
057900*          ELSE                                                   04646005
058000*------------------------------------------------------           04647005
058100*    DATE SPAN, RURAL, AND NO   REPORTING DATA --------           04648005
058200*------------------------------------------------------           04649005
058300*             MOVE 02291.68 TO   FED-EPISODE-RATE-AMT             04649105
058400*             MOVE 02039.60 TO   OUTLIER-THRESHOLD-AMT            04649205
058500*          END-IF                                                 04649305
058600*       ELSE                                                      04649405
058700*------------------------------------------------------           04649505
058800*    DATE SPAN, NON-RURAL, AND WITH REPORTING DATA ----           04649605
058900*------------------------------------------------------           04649705
059000*          IF HHA-WITH-DATA-CHECK                                 04649805
059100*             MOVE 02337.06 TO   FED-EPISODE-RATE-AMT             04649905
059200*             MOVE 02079.98 TO   OUTLIER-THRESHOLD-AMT            04650005
059300*          ELSE                                                   04650105
059400*------------------------------------------------------           04650205
059500*    DATE SPAN, NON-RURAL, AND NO   REPORTING DATA ----           04650305
059600*------------------------------------------------------           04650405
059700*             MOVE 02291.68 TO   FED-EPISODE-RATE-AMT             04650505
059800*             MOVE 02039.60 TO   OUTLIER-THRESHOLD-AMT            04650605
059900*          END-IF                                                 04650705
060000*       END-IF                                                    04650805
060100*    END-IF.                                                      04650905
060200*                                                                 04651005
060300***************************************************************   04652005
060400***************************************************************   04653005
060500                                                                  04654005
060600     IF H-HHA-TOB = '322' OR '332'                                04655005
060700        PERFORM 500-INITIAL-PAYMENT THRU 500-EXIT                 04656005
060800        GO TO 400-EXIT.                                           04657005
060900                                                                  04658005
061000     IF H-HHA-TOB = '329' OR '339' OR '327' OR '337' OR           04659005
061010                    '32Q' OR '33Q' OR
061100                    '32G' OR '33G' OR '32I' OR '33I' OR           04660005
061200                    '32F' OR '32K' OR '32P' OR '32H' OR           04670005
061300                    '33F' OR '33K' OR '33P' OR '33H' OR           04680005
061400                    '32J' OR '33J' OR '32M' OR '33M'              04690005
061500        PERFORM 1000-FINAL-PAYMENT THRU 1000-EXIT                 04700005
061600        GO TO 400-EXIT.                                           04710005
061700                                                                  04720005
061800     MOVE '10' TO H-HHA-PAY-RTC.                                  04730005
061900                                                                  04740005
062000                                                                  04750005
062100 400-EXIT.   EXIT.                                                04760005
062200                                                                  04770005
062300 500-INITIAL-PAYMENT.                                             04780005
062400                                                                  04790005
062500***************************************************************   04800005
062600*            TOB = 322 OR 332 INITIAL PAYMENT                     04810005
062700***************************************************************   04820005
062800                                                                  04830005
062900     IF  H-HHA-INIT-PAY-INDICATOR  = '0' OR '1' OR '2' OR '3'     04840005
063000         NEXT SENTENCE                                            04850005
063100     ELSE                                                         04860005
063200         MOVE '35' TO H-HHA-PAY-RTC                               04870005
063300         GO TO 500-EXIT.                                          04880005
063400                                                                  04890005
063500     IF  H-HHA-INIT-PAY-INDICATOR  = '1' OR '3'                   04900005
063600         MOVE '03' TO H-HHA-PAY-RTC                               04910005
063700         GO TO 500-EXIT.                                          04920005
063800                                                                  04930005
063900     COMPUTE FED-ADJ ROUNDED =                                    04940005
064000               H-HHA-HRG-WGTS (1) * FED-EPISODE-RATE-AMT.         04950005
064100                                                                  04960005
064200     COMPUTE FED-LABOR-ADJ ROUNDED =                              04970005
064300             WIR-CBSA-WAGEIND *                                   04980005
064400             LABOR-PERCENT *                                      04990005
064500             FED-ADJ.                                             05000005
064600                                                                  05010005
064700     COMPUTE FED-NON-LABOR-ADJ ROUNDED =                          05020005
064800              (NONLABOR-PERCENT * FED-ADJ).                       05030005
064900                                                                  05040005
065000     MOVE H-HHA-HRG-OUTPUT-CODE (1) TO WORK-HRG.                  05040005
065100                                                                  05040005
065200*         YEARCHANGE                              ===========**   04500005
065300                                                                  05040005
065400     IF HHA-WITH-DATA-CHECK                                       04600005
065500       NEXT SENTENCE
065600     ELSE
065700       GO TO SUP-CHECK.                                           01650000
065800                                                                  05040005
065900        IF  WORK-HRG5 = 'S' OR '1'                                05041007
066000         MOVE 0000014.39 TO FED-SUPPLY-ADJ                        05041107
066100         GO TO SUP-END.                                           01650000
066200                                                                  05041207
066300        IF  WORK-HRG5 = 'T' OR '2'                                05041307
066400         MOVE 0000051.96 TO FED-SUPPLY-ADJ                        05041107
066500         GO TO SUP-END.                                           01650000
066600                                                                  05041507
066700        IF  WORK-HRG5 = 'U' OR '3'                                05041607
066800         MOVE 0000142.48 TO FED-SUPPLY-ADJ                        05041107
066900         GO TO SUP-END.                                           01650000
067000                                                                  05041807
067100        IF  WORK-HRG5 = 'V' OR '4'                                05041907
067200         MOVE 0000211.69 TO FED-SUPPLY-ADJ                        05041107
067300         GO TO SUP-END.                                           01650000
067400                                                                  05042107
067500        IF  WORK-HRG5 = 'W' OR '5'                                05042207
067600         MOVE 0000326.43 TO FED-SUPPLY-ADJ                        05041107
067700         GO TO SUP-END.                                           01650000
067800                                                                  05042407
067900        IF  WORK-HRG5 = 'X' OR '6'                                05042507
068000         MOVE 0000561.42 TO FED-SUPPLY-ADJ                        05041107
068100         GO TO SUP-END.                                           01650000
068200                                                                  05100005
068300 SUP-CHECK.                                                       05590005
068400                                                                  05100005
068500     IF HHA-NO-DATA-CHECK                                         05100005
068600       NEXT SENTENCE
068700     ELSE
068800       GO TO SUP-END.                                             01650000
068900                                                                  05100005
069000        IF  WORK-HRG5 = 'S' OR '1'                                05041007
069100         MOVE 0000014.11 TO FED-SUPPLY-ADJ                        05041107
069200         GO TO SUP-END.                                           01650000
069300                                                                  05041207
069400        IF  WORK-HRG5 = 'T' OR '2'                                05041307
069500         MOVE 0000050.94 TO FED-SUPPLY-ADJ                        05041107
069600         GO TO SUP-END.                                           01650000
069700                                                                  05041507
069800        IF  WORK-HRG5 = 'U' OR '3'                                05041607
069900         MOVE 0000139.68 TO FED-SUPPLY-ADJ                        05041107
070000         GO TO SUP-END.                                           01650000
070100                                                                  05041807
070200        IF  WORK-HRG5 = 'V' OR '4'                                05041907
070300         MOVE 0000207.52 TO FED-SUPPLY-ADJ                        05041107
070400         GO TO SUP-END.                                           01650000
070500                                                                  05042107
070600        IF  WORK-HRG5 = 'W' OR '5'                                05042207
070700         MOVE 0000320.00 TO FED-SUPPLY-ADJ                        05041107
070800         GO TO SUP-END.                                           01650000
070900                                                                  05042407
071000        IF  WORK-HRG5 = 'X' OR '6'                                05042507
071100         MOVE 0000550.37 TO FED-SUPPLY-ADJ                        05041107
071200         GO TO SUP-END.                                           01650000
071300                                                                  05042407
071400 SUP-END.                                                         05590005
071500                                                                  05042407
071600*         YEARCHANGE                              ===========**   04500005
071700                                                                  05042407
071800*    IF HHA-SERV-THRU-DATE > 20071231 AND                         04580005
071900*       HHA-SERV-FROM-DATE > 20071231                             04590005
072000*        NEXT SENTENCE                                            04850005
072100*    ELSE                                                         05100005
072200*        MOVE 0000000.00 TO FED-SUPPLY-ADJ.                       05041107
072300                                                                  05042707
072400                                                                  05043007
072500     IF H-HHA-SERV-FROM-DATE = H-HHA-ADMIT-DATE                   05050005
072600        COMPUTE H-HHA-TOTAL-PAYMENT ROUNDED =                     05060005
072700       (FED-LABOR-ADJ + FED-NON-LABOR-ADJ + FED-SUPPLY-ADJ) * .6  05070005
072800        MOVE H-HHA-TOTAL-PAYMENT TO H-HHA-HRG-PAY (1)             05080005
072900        MOVE '05' TO H-HHA-PAY-RTC                                05090005
073000     ELSE                                                         05100005
073100        COMPUTE H-HHA-TOTAL-PAYMENT ROUNDED =                     05110005
073200       (FED-LABOR-ADJ + FED-NON-LABOR-ADJ + FED-SUPPLY-ADJ) * .5  05120005
073300        MOVE H-HHA-TOTAL-PAYMENT TO H-HHA-HRG-PAY (1)             05130005
073400        MOVE '04' TO H-HHA-PAY-RTC.                               05140005
073500                                                                  05150005
073600 500-EXIT.   EXIT.                                                05160005
073700                                                                  05170005
073800 1000-FINAL-PAYMENT.                                              05180005
073900                                                                  05190005
074000     IF H-HHA-REVENUE-QTY-COV-VISITS (1) NOT NUMERIC              05200005
074100        MOVE ZEROES TO H-HHA-REVENUE-QTY-COV-VISITS (1).          05210005
074200     IF H-HHA-REVENUE-QTY-COV-VISITS (2) NOT NUMERIC              05220005
074300        MOVE ZEROES TO H-HHA-REVENUE-QTY-COV-VISITS (2).          05230005
074400     IF H-HHA-REVENUE-QTY-COV-VISITS (3) NOT NUMERIC              05240005
074500        MOVE ZEROES TO H-HHA-REVENUE-QTY-COV-VISITS (3).          05250005
074600     IF H-HHA-REVENUE-QTY-COV-VISITS (4) NOT NUMERIC              05260005
074700        MOVE ZEROES TO H-HHA-REVENUE-QTY-COV-VISITS (4).          05270005
074800     IF H-HHA-REVENUE-QTY-COV-VISITS (5) NOT NUMERIC              05280005
074900        MOVE ZEROES TO H-HHA-REVENUE-QTY-COV-VISITS (5).          05290005
075000     IF H-HHA-REVENUE-QTY-COV-VISITS (6) NOT NUMERIC              05300005
075100        MOVE ZEROES TO H-HHA-REVENUE-QTY-COV-VISITS (6).          05310005
075200                                                                  05320005
075300     COMPUTE H-HHA-REVENUE-SUM1-3-QTY-THR ROUNDED =               05330005
075400             H-HHA-REVENUE-QTY-COV-VISITS (1) +                   05340005
075500             H-HHA-REVENUE-QTY-COV-VISITS (2) +                   05350005
075600             H-HHA-REVENUE-QTY-COV-VISITS (3).                    05360005
075700     COMPUTE H-HHA-REVENUE-SUM1-6-QTY-ALL ROUNDED =               05370005
075800             H-HHA-REVENUE-QTY-COV-VISITS (1) +                   05380005
075900             H-HHA-REVENUE-QTY-COV-VISITS (2) +                   05390005
076000             H-HHA-REVENUE-QTY-COV-VISITS (3) +                   05400005
076100             H-HHA-REVENUE-QTY-COV-VISITS (4) +                   05410005
076200             H-HHA-REVENUE-QTY-COV-VISITS (5) +                   05420005
076300             H-HHA-REVENUE-QTY-COV-VISITS (6).                    05430005
076400                                                                  05440005
076500     MOVE H-HHA-HRG-OUTPUT-CODE (1) TO WORK-HRG.                  05040005
076600                                                                  05440005
076700     IF H-HHA-REVENUE-SUM1-6-QTY-ALL < 5                          05450005
076800       NEXT SENTENCE
076900     ELSE
077000       GO TO PEP-CHECK.                                           01650000
077100                                                                  06440005
077200     IF HHA-WITH-DATA-CHECK                                       04600005
077300         COMPUTE LUPA-LABOR-ADJ ROUNDED =                         06330005
077400                 WIR-CBSA-WAGEIND *                               06340005
077500                 LABOR-PERCENT *                                  06350005
077600                 LUPA-ADD-ON                                      06360005
077700     ELSE                                                         06370005
077800         COMPUTE LUPA-LABOR-ADJ ROUNDED =                         06330005
077900                 WIR-CBSA-WAGEIND *                               06340005
078000                 LABOR-PERCENT *                                  06350005
078100                 LUPA-ADD-ON-2PERCENT.                            06360005
078200                                                                  06370005
078300     IF HHA-WITH-DATA-CHECK                                       04600005
078400         COMPUTE LUPA-NON-LABOR-ADJ ROUNDED =                     06380005
078500                 NONLABOR-PERCENT *                               06390005
078600                 LUPA-ADD-ON                                      06400005
078700     ELSE                                                         06370005
078800         COMPUTE LUPA-NON-LABOR-ADJ ROUNDED =                     06380005
078900                 NONLABOR-PERCENT *                               06390005
079000                 LUPA-ADD-ON-2PERCENT.                            06360005
079100                                                                  06410005
079200                                                                  05040005
079300     IF H-HHA-ADMIT-DATE = H-HHA-SERV-FROM-DATE AND               04040005
079400         WORK-HRG1 = '1' OR '2'                                   05041007
079500        COMPUTE H-HHA-LUPA-ADD-ON-PAYMENT ROUNDED =               01650000
079600          LUPA-LABOR-ADJ + LUPA-NON-LABOR-ADJ
079700     ELSE
079800        MOVE 0 TO  H-HHA-LUPA-ADD-ON-PAYMENT.                     01650000
079900                                                                  06440005
080000     IF (H-HHA-LUPA-SRC-ADM = 'B' OR 'C')                         02603005
080100        MOVE 0 TO  H-HHA-LUPA-ADD-ON-PAYMENT.                     01650000
080200                                                                  06440005
080300     IF  H-HHA-RECODE-IND  = '2'
080400        MOVE 0 TO  H-HHA-LUPA-ADD-ON-PAYMENT.                     01650000
080500                                                                  06440005
080600     IF H-HHA-REVENUE-SUM1-6-QTY-ALL = 0                          05450005
080700        MOVE 0 TO  H-HHA-LUPA-ADD-ON-PAYMENT.                     01650000
080800                                                                  06440005
080900        PERFORM 1050-LUPA THRU 1050-EXIT                          05460005
081000            VARYING SUB1 FROM 1 BY 1 UNTIL                        05470005
081100***         (H-HHA-REVENUE-CODE (SUB1) = SPACES OR                05480005
081200             SUB1 > 6.                                            05490005
081300                                                                  06440005
081400        IF H-HHA-LUPA-ADD-ON-PAYMENT > 0                          06440005
081500           MOVE '14' TO H-HHA-PAY-RTC                             06440005
081600        ELSE                                                      06440005
081700           MOVE '06' TO H-HHA-PAY-RTC                             05500005
081800        END-IF.                                                   06440005
081900                                                                  06440005
082000        COMPUTE H-HHA-TOTAL-PAYMENT   ROUNDED =                   05510005
082100                H-HHA-REVENUE-COST (1) +                          05520005
082200                H-HHA-REVENUE-COST (2) +                          05530005
082300                H-HHA-REVENUE-COST (3) +                          05540005
082400                H-HHA-REVENUE-COST (4) +                          05550005
082500                H-HHA-REVENUE-COST (5) +                          05560005
082600                H-HHA-REVENUE-COST (6) +                          05570005
082700                H-HHA-LUPA-ADD-ON-PAYMENT.                        01650000
082800                                                                  06440005
082900        GO TO 1000-EXIT.                                          05580005
083000                                                                  05590005
083100 PEP-CHECK.                                                       05590005
083200                                                                  05590005
083300     IF (H-HHA-PEP-INDICATOR NOT = 'Y' AND NOT = 'N')             05600005
083400         MOVE '20' TO H-HHA-PAY-RTC                               05610005
083500         GO TO 1000-EXIT.                                         05620005
083600                                                                  05630005
083700      PERFORM 1100-ADD-HRG-DAYS THRU 1100-EXIT                    05640005
083800         VARYING CO1 FROM 1 BY 1 UNTIL CO1 > 6.                   05650005
083900                                                                  05660005
084000      IF WK-HRG-NO-OF-DAYS-TOT > 60                               05670005
084100         MOVE '16' TO H-HHA-PAY-RTC                               05680005
084200         GO TO 1000-EXIT.                                         05690005
084300                                                                  05700005
084400                                                                  05710005
084500*********  HRG  PAYMENT   *******************                     05720005
084600                                                                  05730005
084700***  IF H-HHA-REVENUE-SUM1-3-QTY-THR > 9                          05740005
084800        IF H-HHA-HRG-INPUT-CODE (2) = SPACES                      05750005
084900           IF H-HHA-PEP-INDICATOR = 'N'                           05760005
085000              PERFORM 3000-PEP-N-ADJUST THRU 3000-EXIT            05770005
085100                  VARYING CO1 FROM 1 BY 1 UNTIL                   05780005
085200*                 (H-HHA-HRG-INPUT-CODE (CO1) = SPACES OR         05790005
085300                   CO1 > 6                                        05800005
085400               PERFORM 7000-OUTLIER-PAYMENT THRU 7000-EXIT        05810005
085500               GO TO 1000-EXIT.                                   05820005
085600                                                                  05830005
085700                                                                  05840005
085800***  IF H-HHA-REVENUE-SUM1-3-QTY-THR > 9                          05850005
085900        IF H-HHA-HRG-INPUT-CODE (2) = SPACES                      05860005
086000           IF H-HHA-PEP-INDICATOR = 'Y'                           05870005
086100              PERFORM 4000-PEP-Y-ADJUST THRU 4000-EXIT            05880005
086200                  VARYING CO1 FROM 1 BY 1 UNTIL                   05890005
086300*                 (H-HHA-HRG-INPUT-CODE (CO1) = SPACES OR         05900005
086400                   CO1 > 6                                        05910005
086500               PERFORM 7000-OUTLIER-PAYMENT THRU 7000-EXIT        05920005
086600               GO TO 1000-EXIT.                                   05930005
086700                                                                  05940005
086800**** IF H-HHA-REVENUE-SUM1-3-QTY-THR > 9                          05950005
086900        IF H-HHA-HRG-INPUT-CODE (2) NOT = SPACES                  05960005
087000           IF H-HHA-PEP-INDICATOR = 'N'                           05970005
087100              PERFORM 5000-PEP-N-ADJUST THRU 5000-EXIT            05980005
087200                  VARYING CO1 FROM 1 BY 1 UNTIL                   05990005
087300*                 (H-HHA-HRG-INPUT-CODE (CO1) = SPACES OR         06000005
087400                   CO1 > 6                                        06010005
087500               PERFORM 7000-OUTLIER-PAYMENT THRU 7000-EXIT        06020005
087600               GO TO 1000-EXIT.                                   06030005
087700                                                                  06040005
087800**** IF H-HHA-REVENUE-SUM1-3-QTY-THR > 9                          06050005
087900        IF H-HHA-HRG-INPUT-CODE (2) NOT = SPACES                  06060005
088000           IF H-HHA-PEP-INDICATOR = 'Y'                           06070005
088100              PERFORM 6000-PEP-Y-ADJUST THRU 6000-EXIT            06080005
088200                  VARYING CO1 FROM 1 BY 1 UNTIL                   06090005
088300*                 (H-HHA-HRG-INPUT-CODE (CO1) = SPACES OR         06100005
088400                   CO1 > 6                                        06110005
088500               PERFORM 7000-OUTLIER-PAYMENT THRU 7000-EXIT        06120005
088600               GO TO 1000-EXIT.                                   06130005
088700                                                                  06140005
088800                                                                  06150005
088900      MOVE '20' TO H-HHA-PAY-RTC.                                 06160005
089000                                                                  06170005
089100 1000-EXIT.  EXIT.                                                06180005
089200 1050-LUPA.                                                       06190005
089300                                                                  06200005
089400***************************************************************   06210005
089500*                    LUPA PAYMENT                                 06220005
089600***************************************************************   06230005
089700                                                                  06240005
089800     IF H-HHA-REVENUE-CODE (SUB1) = SPACES                        06250005
089900        MOVE 6 TO SUB1                                            06260005
090000        GO TO 1050-EXIT.                                          06270005
090100
090200     IF H-HHA-REVENUE-QTY-COV-VISITS (SUB1) = 0                   06300005
090300        GO TO 1050-EXIT.                                          06270005
090400
090500     MOVE H-HHA-HRG-OUTPUT-CODE (SUB1) TO WORK-HRG.               05040005
090600                                                                  05040005
090700     COMPUTE FED-ADJ ROUNDED =                                    06290005
090800             H-HHA-REVENUE-QTY-COV-VISITS (SUB1) *                06300005
090900             H-HHA-REVENUE-DOLL-RATE (SUB1).                      06310005
091000                                                                  06320005
091100     COMPUTE FED-LABOR-ADJ ROUNDED =                              06330005
091200             WIR-CBSA-WAGEIND *                                   06340005
091300             LABOR-PERCENT *                                      06350005
091400             FED-ADJ.                                             06360005
091500                                                                  06370005
091600                                                                  06370005
091700     COMPUTE FED-NON-LABOR-ADJ ROUNDED =                          06380005
091800             NONLABOR-PERCENT *                                   06390005
091900             FED-ADJ.                                             06400005
092000                                                                  06410005
092100     MOVE H-HHA-HRG-OUTPUT-CODE (1) TO WORK-HRG.                  05040005
092200     COMPUTE H-HHA-REVENUE-COST (SUB1) ROUNDED =                  06420005
092300             (FED-LABOR-ADJ + FED-NON-LABOR-ADJ).                 01650000
092400                                                                  06440005
092500                                                                  06410005
092600 1050-EXIT.   EXIT.                                               06450005
092700                                                                  06460005
092800 1100-ADD-HRG-DAYS.                                               06470005
092900                                                                  06480005
093000      IF H-HHA-HRG-NO-OF-DAYS (CO1) NUMERIC                       06490005
093100         ADD H-HHA-HRG-NO-OF-DAYS (CO1) TO                        06500005
093200             WK-HRG-NO-OF-DAYS-TOT.                               06510005
093300                                                                  06520005
093400 1100-EXIT.   EXIT.                                               06530005
093500                                                                  06540005
093600 3000-PEP-N-ADJUST.                                               06550005
093700                                                                  06560005
093800***************************************************************   06570005
093900*           HRG OCCUR < 2 AND PEP = N ADJUSTMENT                  06580005
094000***************************************************************   06590005
094100                                                                  06600005
094200     IF H-HHA-HRG-INPUT-CODE (CO1) = SPACES                       06610005
094300        MOVE 6 TO CO1                                             06620005
094400        GO TO 3000-EXIT.                                          06630005
094500                                                                  06640005
094600     MOVE H-HHA-HRG-NO-OF-DAYS (CO1) TO WK-HRG-NO-OF-DAYS.        06650005
094700                                                                  06660005
094800     MOVE H-HHA-HRG-OUTPUT-CODE (CO1) TO WORK-HRG.                05040005
094900                                                                  06660005
095000*         YEARCHANGE                              ===========**   04500005
095100                                                                  06660005
095200     IF HHA-WITH-DATA-CHECK                                       04600005
095300       NEXT SENTENCE
095400     ELSE
095500       GO TO NO-DATA-CHECK1.                                      01650000
095600                                                                  05100005
095700        IF  WORK-HRG5 = 'S' OR '1'                                05041007
095800         MOVE 0000014.39 TO FED-SUPPLY-ADJ                        05041107
095900         GO TO DATA-CHECK-END1.                                   01650000
096000                                                                  05041207
096100        IF  WORK-HRG5 = 'T' OR '2'                                05041307
096200         MOVE 0000051.96 TO FED-SUPPLY-ADJ                        05041107
096300         GO TO DATA-CHECK-END1.                                   01650000
096400                                                                  05041507
096500        IF  WORK-HRG5 = 'U' OR '3'                                05041607
096600         MOVE 0000142.48 TO FED-SUPPLY-ADJ                        05041107
096700         GO TO DATA-CHECK-END1.                                   01650000
096800                                                                  05041807
096900        IF  WORK-HRG5 = 'V' OR '4'                                05041907
097000         MOVE 0000211.69 TO FED-SUPPLY-ADJ                        05041107
097100         GO TO DATA-CHECK-END1.                                   01650000
097200                                                                  05042107
097300        IF  WORK-HRG5 = 'W' OR '5'                                05042207
097400         MOVE 0000326.43 TO FED-SUPPLY-ADJ                        05041107
097500         GO TO DATA-CHECK-END1.                                   01650000
097600                                                                  05042407
097700        IF  WORK-HRG5 = 'X' OR '6'                                05042507
097800         MOVE 0000561.42 TO FED-SUPPLY-ADJ.                       05041107
097900         GO TO DATA-CHECK-END1.                                   01650000
098000                                                                  05100005
098100 NO-DATA-CHECK1.                                                  05100005
098200                                                                  05100005
098300     IF HHA-NO-DATA-CHECK                                         05100005
098400       NEXT SENTENCE
098500     ELSE
098600       GO TO DATA-CHECK-END1.                                     01650000
098700                                                                  05100005
098800        IF  WORK-HRG5 = 'S' OR '1'                                05041007
098900         MOVE 0000014.11 TO FED-SUPPLY-ADJ                        05041107
099000         GO TO DATA-CHECK-END1.                                   01650000
099100                                                                  05041207
099200        IF  WORK-HRG5 = 'T' OR '2'                                05041307
099300         MOVE 0000050.94 TO FED-SUPPLY-ADJ                        05041107
099400         GO TO DATA-CHECK-END1.                                   01650000
099500                                                                  05041507
099600        IF  WORK-HRG5 = 'U' OR '3'                                05041607
099700         MOVE 0000139.68 TO FED-SUPPLY-ADJ                        05041107
099800         GO TO DATA-CHECK-END1.                                   01650000
099900                                                                  05041807
100000        IF  WORK-HRG5 = 'V' OR '4'                                05041907
100100         MOVE 0000207.52 TO FED-SUPPLY-ADJ                        05041107
100200         GO TO DATA-CHECK-END1.                                   01650000
100300                                                                  05042107
100400        IF  WORK-HRG5 = 'W' OR '5'                                05042207
100500         MOVE 0000320.00 TO FED-SUPPLY-ADJ                        05041107
100600         GO TO DATA-CHECK-END1.                                   01650000
100700                                                                  05042407
100800        IF  WORK-HRG5 = 'X' OR '6'                                05042507
100900         MOVE 0000550.37 TO FED-SUPPLY-ADJ                        05041107
101000         GO TO DATA-CHECK-END1.                                   01650000
101100                                                                  05040005
101200 DATA-CHECK-END1.                                                 05100005
101300                                                                  05040005
101400*         YEARCHANGE                              ===========**   04500005
101500                                                                  06660005
101600                                                                  05042407
101700*    IF HHA-SERV-THRU-DATE > 20071231 AND                         04580005
101800*       HHA-SERV-FROM-DATE > 20071231                             04590005
101900*        NEXT SENTENCE                                            04850005
102000*    ELSE                                                         05100005
102100*        MOVE 0000000.00 TO FED-SUPPLY-ADJ.                       05041107
102200                                                                  05042707
102300     COMPUTE FED-ADJ ROUNDED =                                    04940005
102400               H-HHA-HRG-WGTS (1) * FED-EPISODE-RATE-AMT.         04950005
102500                                                                  05042707
102600     COMPUTE FED-LABOR-ADJ ROUNDED =                              06720005
102700              (WIR-CBSA-WAGEIND *                                 06730005
102800               LABOR-PERCENT * FED-ADJ).                          06740005
102900                                                                  06750005
103000     COMPUTE FED-NON-LABOR-ADJ ROUNDED =                          06760005
103100              (NONLABOR-PERCENT * FED-ADJ).                       06770005
103200                                                                  06780005
103300     COMPUTE WK-3000-PEP-N-PAYMENT ROUNDED =                      06790005
103400          (FED-LABOR-ADJ + FED-NON-LABOR-ADJ + FED-SUPPLY-ADJ).   06800005
103500                                                                  06810005
103600     COMPUTE H-HHA-HRG-PAY (CO1) ROUNDED =                        06820005
103700             WK-3000-PEP-N-PAYMENT.                               06830005
103800                                                                  06840005
103900     COMPUTE WK-3000-PEP-N-PRETOT-PAY ROUNDED =                   06850005
104000             WK-3000-PEP-N-PRETOT-PAY + WK-3000-PEP-N-PAYMENT.    06860005
104100                                                                  06870005
104200                                                                  06880005
104300 3000-EXIT.   EXIT.                                               06890005
104400                                                                  06900005
104500 4000-PEP-Y-ADJUST.                                               06910005
104600                                                                  06920005
104700***************************************************************   06930005
104800*           HRG OCCUR < 2 AND PEP = Y ADJUSTMENT                  06940005
104900***************************************************************   06950005
105000                                                                  06960005
105100     IF H-HHA-HRG-INPUT-CODE (CO1) = SPACES                       06970005
105200        MOVE 6 TO SUB1                                            06980005
105300        GO TO 4000-EXIT.                                          06990005
105400                                                                  07000005
105500     MOVE 2 TO WK-RTC-ADJ-IND.                                    07010005
105600                                                                  07020005
105700     MOVE H-HHA-HRG-NO-OF-DAYS (CO1) TO WK-HRG-NO-OF-DAYS.        07030005
105800                                                                  06660005
105900     MOVE H-HHA-HRG-OUTPUT-CODE (CO1) TO WORK-HRG.                05040005
106000                                                                  05040005
106100*         YEARCHANGE                              ===========**   04500005
106200                                                                  06660005
106300     IF HHA-WITH-DATA-CHECK                                       04600005
106400       NEXT SENTENCE
106500     ELSE
106600       GO TO NO-DATA-CHECK2.                                      01650000
106700                                                                  05100005
106800        IF  WORK-HRG5 = 'S' OR '1'                                05041007
106900         MOVE 0000014.39 TO FED-SUPPLY-ADJ                        05041107
107000         GO TO DATA-CHECK-END2.                                   01650000
107100                                                                  05041207
107200        IF  WORK-HRG5 = 'T' OR '2'                                05041307
107300         MOVE 0000051.96 TO FED-SUPPLY-ADJ                        05041107
107400         GO TO DATA-CHECK-END2.                                   01650000
107500                                                                  05041507
107600        IF  WORK-HRG5 = 'U' OR '3'                                05041607
107700         MOVE 0000142.48 TO FED-SUPPLY-ADJ                        05041107
107800         GO TO DATA-CHECK-END2.                                   01650000
107900                                                                  05041807
108000        IF  WORK-HRG5 = 'V' OR '4'                                05041907
108100         MOVE 0000211.69 TO FED-SUPPLY-ADJ                        05041107
108200         GO TO DATA-CHECK-END2.                                   01650000
108300                                                                  05042107
108400        IF  WORK-HRG5 = 'W' OR '5'                                05042207
108500         MOVE 0000326.43 TO FED-SUPPLY-ADJ                        05041107
108600         GO TO DATA-CHECK-END2.                                   01650000
108700                                                                  05042407
108800        IF  WORK-HRG5 = 'X' OR '6'                                05042507
108900         MOVE 0000561.42 TO FED-SUPPLY-ADJ                        05041107
109000         GO TO DATA-CHECK-END2.                                   01650000
109100                                                                  05100005
109200 NO-DATA-CHECK2.                                                  01650000
109300                                                                  05100005
109400     IF HHA-NO-DATA-CHECK                                         05100005
109500       NEXT SENTENCE
109600     ELSE
109700       GO TO DATA-CHECK-END2.                                     01650000
109800                                                                  05100005
109900        IF  WORK-HRG5 = 'S' OR '1'                                05041007
110000         MOVE 0000014.11 TO FED-SUPPLY-ADJ                        05041107
110100         GO TO DATA-CHECK-END2.                                   01650000
110200                                                                  05041207
110300        IF  WORK-HRG5 = 'T' OR '2'                                05041307
110400         MOVE 0000050.94 TO FED-SUPPLY-ADJ                        05041107
110500         GO TO DATA-CHECK-END2.                                   01650000
110600                                                                  05041507
110700        IF  WORK-HRG5 = 'U' OR '3'                                05041607
110800         MOVE 0000139.68 TO FED-SUPPLY-ADJ                        05041107
110900         GO TO DATA-CHECK-END2.                                   01650000
111000                                                                  05041807
111100        IF  WORK-HRG5 = 'V' OR '4'                                05041907
111200         MOVE 0000207.52 TO FED-SUPPLY-ADJ                        05041107
111300         GO TO DATA-CHECK-END2.                                   01650000
111400                                                                  05042107
111500        IF  WORK-HRG5 = 'W' OR '5'                                05042207
111600         MOVE 0000320.00 TO FED-SUPPLY-ADJ                        05041107
111700         GO TO DATA-CHECK-END2.                                   01650000
111800                                                                  05042407
111900        IF  WORK-HRG5 = 'X' OR '6'                                05042507
112000         MOVE 0000550.37 TO FED-SUPPLY-ADJ                        05041107
112100         GO TO DATA-CHECK-END2.                                   01650000
112200                                                                  05040005
112300 DATA-CHECK-END2.                                                 01650000
112400                                                                  05042707
112500*         YEARCHANGE                              ===========**   04500005
112600                                                                  06660005
112700                                                                  05042407
112800*    IF HHA-SERV-THRU-DATE > 20071231 AND                         04580005
112900*       HHA-SERV-FROM-DATE > 20071231                             04590005
113000*        NEXT SENTENCE                                            04850005
113100*    ELSE                                                         05100005
113200*        MOVE 0000000.00 TO FED-SUPPLY-ADJ.                       05041107
113300                                                                  05042707
113400                                                                  05042707
113500     COMPUTE FED-ADJ ROUNDED =                                    04940005
113600               H-HHA-HRG-WGTS (1) * FED-EPISODE-RATE-AMT.         04950005
113700                                                                  07090005
113800     COMPUTE FED-LABOR-ADJ ROUNDED =                              07100005
113900               WIR-CBSA-WAGEIND *                                 07110005
114000               LABOR-PERCENT * FED-ADJ.                           07120005
114100                                                                  07130005
114200     COMPUTE FED-NON-LABOR-ADJ ROUNDED =                          07140005
114300               NONLABOR-PERCENT * FED-ADJ.                        07150005
114400                                                                  07160005
114500     COMPUTE WK-4000-PEP-Y-PAYMENT ROUNDED =                      07170005
114600         (FED-LABOR-ADJ + FED-NON-LABOR-ADJ + FED-SUPPLY-ADJ).    07180005
114700                                                                  07190005
114800     COMPUTE WK-HRG-NO-OF-DAYS-FAC ROUNDED =                      07170005
114900               (WK-HRG-NO-OF-DAYS / 60).                          07060005
115000                                                                  07190005
115100     COMPUTE WK-4000-PEP-Y-PAYMENT ROUNDED =                      07170005
115200             WK-4000-PEP-Y-PAYMENT *
115300             WK-HRG-NO-OF-DAYS-FAC.                               07170005
115400                                                                  07190005
115500     COMPUTE H-HHA-HRG-PAY (CO1) ROUNDED =                        07200005
115600             WK-4000-PEP-Y-PAYMENT.                               07210005
115700                                                                  07220005
115800     COMPUTE WK-4000-PEP-Y-PRETOT-PAY ROUNDED =                   07230005
115900             WK-4000-PEP-Y-PRETOT-PAY + WK-4000-PEP-Y-PAYMENT.    07240005
116000                                                                  07250005
116100                                                                  07260005
116200 4000-EXIT.   EXIT.                                               07270005
116300 5000-PEP-N-ADJUST.                                               07280005
116400                                                                  07290005
116500***************************************************************   07300005
116600*           HRG OCCUR > 1 AND PEP = N ADJUSTMENT                  07310005
116700***************************************************************   07320005
116800                                                                  07330005
116900     IF H-HHA-HRG-INPUT-CODE (CO1) = SPACES                       07340005
117000        MOVE 6 TO SUB1                                            07350005
117100        GO TO 5000-EXIT.                                          07360005
117200                                                                  07370005
117300     MOVE 1 TO WK-RTC-ADJ-IND.                                    07380005
117400                                                                  07390005
117500     MOVE H-HHA-HRG-NO-OF-DAYS (CO1) TO WK-HRG-NO-OF-DAYS.        07400005
117600                                                                  06660005
117700     MOVE H-HHA-HRG-OUTPUT-CODE (CO1) TO WORK-HRG.                05040005
117800                                                                  05040005
117900*         YEARCHANGE                              ===========**   04500005
118000                                                                  06660005
118100     IF HHA-WITH-DATA-CHECK                                       06660005
118200       NEXT SENTENCE
118300     ELSE
118400       GO TO NO-DATA-CHECK3.                                      01650000
118500                                                                  05100005
118600        IF  WORK-HRG5 = 'S' OR '1'                                05041007
118700         MOVE 0000014.39 TO FED-SUPPLY-ADJ                        05041107
118800         GO TO DATA-CHECK-END3.                                   01650000
118900                                                                  05041207
119000        IF  WORK-HRG5 = 'T' OR '2'                                05041307
119100         MOVE 0000051.96 TO FED-SUPPLY-ADJ                        05041107
119200         GO TO DATA-CHECK-END3.                                   01650000
119300                                                                  05041507
119400        IF  WORK-HRG5 = 'U' OR '3'                                05041607
119500         MOVE 0000142.48 TO FED-SUPPLY-ADJ                        05041107
119600         GO TO DATA-CHECK-END3.                                   01650000
119700                                                                  05041807
119800        IF  WORK-HRG5 = 'V' OR '4'                                05041907
119900         MOVE 0000211.69 TO FED-SUPPLY-ADJ                        05041107
120000         GO TO DATA-CHECK-END3.                                   01650000
120100                                                                  05042107
120200        IF  WORK-HRG5 = 'W' OR '5'                                05042207
120300         MOVE 0000326.43 TO FED-SUPPLY-ADJ                        05041107
120400         GO TO DATA-CHECK-END3.                                   01650000
120500                                                                  05042407
120600        IF  WORK-HRG5 = 'X' OR '6'                                05042507
120700         MOVE 0000561.42 TO FED-SUPPLY-ADJ                        05041107
120800         GO TO DATA-CHECK-END3.                                   01650000
120900                                                                  05100005
121000 NO-DATA-CHECK3.                                                  01650000
121100                                                                  05100005
121200     IF HHA-NO-DATA-CHECK                                         05100005
121300       NEXT SENTENCE
121400     ELSE
121500       GO TO DATA-CHECK-END3.                                     01650000
121600                                                                  05100005
121700        IF  WORK-HRG5 = 'S' OR '1'                                05041007
121800         MOVE 0000014.11 TO FED-SUPPLY-ADJ                        05041107
121900         GO TO DATA-CHECK-END3.                                   01650000
122000                                                                  05041207
122100        IF  WORK-HRG5 = 'T' OR '2'                                05041307
122200         MOVE 0000050.94 TO FED-SUPPLY-ADJ                        05041107
122300         GO TO DATA-CHECK-END3.                                   01650000
122400                                                                  05041507
122500        IF  WORK-HRG5 = 'U' OR '3'                                05041607
122600         MOVE 0000139.68 TO FED-SUPPLY-ADJ                        05041107
122700         GO TO DATA-CHECK-END3.                                   01650000
122800                                                                  05041807
122900        IF  WORK-HRG5 = 'V' OR '4'                                05041907
123000         MOVE 0000207.52 TO FED-SUPPLY-ADJ                        05041107
123100         GO TO DATA-CHECK-END3.                                   01650000
123200                                                                  05042107
123300        IF  WORK-HRG5 = 'W' OR '5'                                05042207
123400         MOVE 0000320.00 TO FED-SUPPLY-ADJ                        05041107
123500         GO TO DATA-CHECK-END3.                                   01650000
123600                                                                  05042407
123700        IF  WORK-HRG5 = 'X' OR '6'                                05042507
123800         MOVE 0000550.37 TO FED-SUPPLY-ADJ                        05041107
123900         GO TO DATA-CHECK-END3.                                   01650000
124000                                                                  05042707
124100 DATA-CHECK-END3.                                                 01650000
124200                                                                  05042707
124300*         YEARCHANGE                              ===========**   04500005
124400                                                                  06660005
124500                                                                  05042407
124600*    IF HHA-SERV-THRU-DATE > 20071231 AND                         04580005
124700*       HHA-SERV-FROM-DATE > 20071231                             04590005
124800*        NEXT SENTENCE                                            04850005
124900*    ELSE                                                         05100005
125000*        MOVE 0000000.00 TO FED-SUPPLY-ADJ.                       05041107
125100                                                                  05042707
125200                                                                  07410005
125300     COMPUTE FED-ADJ ROUNDED =                                    07420005
125400               (WK-HRG-NO-OF-DAYS  *                              07430005
125500                H-HHA-HRG-WGTS (CO1) *                            07440005
125600                FED-EPISODE-RATE-AMT) / 60.                       07450005
125700                                                                  07460005
125800     COMPUTE FED-LABOR-ADJ ROUNDED =                              07470005
125900               WIR-CBSA-WAGEIND *                                 07480005
126000               LABOR-PERCENT * FED-ADJ.                           07490005
126100                                                                  07500005
126200     COMPUTE FED-NON-LABOR-ADJ ROUNDED =                          07510005
126300               NONLABOR-PERCENT * FED-ADJ.                        07520005
126400                                                                  07530005
126500     COMPUTE WK-5000-PEP-N-PAYMENT ROUNDED =                      07540005
126600           (FED-LABOR-ADJ + FED-NON-LABOR-ADJ + FED-SUPPLY-ADJ).  07550005
126700                                                                  07560005
126800     COMPUTE H-HHA-HRG-PAY (CO1) ROUNDED =                        07570005
126900             WK-5000-PEP-N-PAYMENT.                               07580005
127000                                                                  07590005
127100                                                                  07600005
127200     COMPUTE WK-5000-PEP-N-PRETOT-PAY ROUNDED =                   07610005
127300             WK-5000-PEP-N-PRETOT-PAY + WK-5000-PEP-N-PAYMENT.    07620005
127400                                                                  07630005
127500                                                                  07640005
127600 5000-EXIT.   EXIT.                                               07650005
127700 6000-PEP-Y-ADJUST.                                               07660005
127800                                                                  07670005
127900***************************************************************   07680005
128000*           HRG OCCUR > 1 AND PEP = Y SHORTENED EPISODE           07690005
128100***************************************************************   07700005
128200                                                                  07710005
128300     IF H-HHA-HRG-INPUT-CODE (CO1) = SPACES                       07720005
128400        MOVE 6 TO SUB1                                            07730005
128500        GO TO 6000-EXIT.                                          07740005
128600                                                                  07750005
128700     MOVE 3 TO WK-RTC-ADJ-IND.                                    07760005
128800                                                                  07770005
128900     MOVE H-HHA-HRG-NO-OF-DAYS (CO1) TO WK-HRG-NO-OF-DAYS.        07780005
129000     MOVE H-HHA-PEP-DAYS             TO WK-PEP-DAYS.              07790005
129100                                                                  07800005
129200     MOVE H-HHA-HRG-OUTPUT-CODE (CO1) TO WORK-HRG.                05040005
129300                                                                  05040005
129400*         YEARCHANGE                              ===========**   04500005
129500                                                                  06660005
129600     IF HHA-WITH-DATA-CHECK                                       05042707
129700       NEXT SENTENCE
129800     ELSE
129900       GO TO NO-DATA-CHECK4.                                      01650000
130000                                                                  05100005
130100        IF  WORK-HRG5 = 'S' OR '1'                                05041007
130200         MOVE 0000014.39 TO FED-SUPPLY-ADJ                        05041107
130300         GO TO DATA-CHECK-END4.                                   01650000
130400                                                                  05041207
130500        IF  WORK-HRG5 = 'T' OR '2'                                05041307
130600         MOVE 0000051.96 TO FED-SUPPLY-ADJ                        05041107
130700         GO TO DATA-CHECK-END4.                                   01650000
130800                                                                  05041507
130900        IF  WORK-HRG5 = 'U' OR '3'                                05041607
131000         MOVE 0000142.48 TO FED-SUPPLY-ADJ                        05041107
131100         GO TO DATA-CHECK-END4.                                   01650000
131200                                                                  05041807
131300        IF  WORK-HRG5 = 'V' OR '4'                                05041907
131400         MOVE 0000211.69 TO FED-SUPPLY-ADJ                        05041107
131500         GO TO DATA-CHECK-END4.                                   01650000
131600                                                                  05042107
131700        IF  WORK-HRG5 = 'W' OR '5'                                05042207
131800         MOVE 0000326.43 TO FED-SUPPLY-ADJ                        05041107
131900         GO TO DATA-CHECK-END4.                                   01650000
132000                                                                  05042407
132100        IF  WORK-HRG5 = 'X' OR '6'                                05042507
132200         MOVE 0000561.42 TO FED-SUPPLY-ADJ                        05041107
132300         GO TO DATA-CHECK-END4.                                   01650000
132400                                                                  05100005
132500 NO-DATA-CHECK4.                                                  01650000
132600                                                                  05100005
132700     IF HHA-NO-DATA-CHECK                                         05100005
132800       NEXT SENTENCE
132900     ELSE
133000       GO TO DATA-CHECK-END4.                                     01650000
133100                                                                  05100005
133200     IF HHA-NO-DATA-CHECK                                         05100005
133300        IF  WORK-HRG5 = 'S' OR '1'                                05041007
133400         MOVE 0000014.11 TO FED-SUPPLY-ADJ                        05041107
133500         GO TO DATA-CHECK-END4.                                   01650000
133600                                                                  05041207
133700        IF  WORK-HRG5 = 'T' OR '2'                                05041307
133800         MOVE 0000050.94 TO FED-SUPPLY-ADJ                        05041107
133900         GO TO DATA-CHECK-END4.                                   01650000
134000                                                                  05041507
134100        IF  WORK-HRG5 = 'U' OR '3'                                05041607
134200         MOVE 0000139.68 TO FED-SUPPLY-ADJ                        05041107
134300         GO TO DATA-CHECK-END4.                                   01650000
134400                                                                  05041807
134500        IF  WORK-HRG5 = 'V' OR '4'                                05041907
134600         MOVE 0000207.52 TO FED-SUPPLY-ADJ                        05041107
134700         GO TO DATA-CHECK-END4.                                   01650000
134800                                                                  05042107
134900        IF  WORK-HRG5 = 'W' OR '5'                                05042207
135000         MOVE 0000320.00 TO FED-SUPPLY-ADJ                        05041107
135100         GO TO DATA-CHECK-END4.                                   01650000
135200                                                                  05042407
135300        IF  WORK-HRG5 = 'X' OR '6'                                05042507
135400         MOVE 0000550.37 TO FED-SUPPLY-ADJ.                       05041107
135500         GO TO DATA-CHECK-END4.                                   01650000
135600                                                                  05042707
135700 DATA-CHECK-END4.                                                 01650000
135800                                                                  05042707
135900*         YEARCHANGE                              ===========**   04500005
136000                                                                  05042707
136100                                                                  05042407
136200*    IF HHA-SERV-THRU-DATE > 20071231 AND                         04580005
136300*       HHA-SERV-FROM-DATE > 20071231                             04590005
136400*        NEXT SENTENCE                                            04850005
136500*    ELSE                                                         05100005
136600*        MOVE 0000000.00 TO FED-SUPPLY-ADJ.                       05041107
136700*                                                                 05042707
136800*    COMPUTE FED-ADJ ROUNDED =                                    07810005
136900*        (WK-HRG-NO-OF-DAYS / WK-PEP-DAYS)                        07820005
137000*                                *                                07830005
137100*                    ((WK-PEP-DAYS / 60)                          07840005
137200*                                *                                07850005
137300*          (H-HHA-HRG-WGTS (CO1) * FED-EPISODE-RATE-AMT)).        07860005
137400*                                                                 07870005
137500*                                                                 07880005
137600*    COMPUTE FED-ADJ ROUNDED =                                    07890005
137700*        (WK-HRG-NO-OF-DAYS / WK-PEP-DAYS)                        07900005
137800*                                *                                07910005
137900*      ((WK-PEP-DAYS * H-HHA-HRG-WGTS (CO1) *                     07920005
138000*                          FED-EPISODE-RATE-AMT) / 60).           07930005
138100                                                                  07940005
138200     COMPUTE FED-ADJ1 ROUNDED =                                   07950005
138300      ((WK-PEP-DAYS * H-HHA-HRG-WGTS (CO1) *                      07960005
138400                           FED-EPISODE-RATE-AMT) / 60).           07970005
138500                                                                  07980005
138600     COMPUTE FED-ADJ ROUNDED  =                                   07990005
138700                  (FED-ADJ1 * WK-HRG-NO-OF-DAYS) / WK-PEP-DAYS.   08000005
138800                                                                  08010005
138900     COMPUTE FED-LABOR-ADJ ROUNDED =                              08020005
139000               WIR-CBSA-WAGEIND *                                 08030005
139100               LABOR-PERCENT * FED-ADJ.                           08040005
139200                                                                  08050005
139300     COMPUTE FED-NON-LABOR-ADJ ROUNDED =                          08060005
139400               NONLABOR-PERCENT * FED-ADJ.                        08070005
139500                                                                  08080005
139600     COMPUTE WK-6000-PEP-Y-PAYMENT ROUNDED =                      08090005
139700          (FED-LABOR-ADJ + FED-NON-LABOR-ADJ + FED-SUPPLY-ADJ).   08100005
139800                                                                  08110005
139900     COMPUTE H-HHA-HRG-PAY (CO1) ROUNDED =                        08120005
140000             WK-6000-PEP-Y-PAYMENT.                               08130005
140100                                                                  08140005
140200     COMPUTE WK-6000-PEP-Y-PRETOT-PAY ROUNDED =                   08150005
140300             WK-6000-PEP-Y-PRETOT-PAY + WK-6000-PEP-Y-PAYMENT.    08160005
140400                                                                  08170005
140500                                                                  08180005
140600 6000-EXIT.   EXIT.                                               08190005
140700                                                                  08200005
140800 7000-OUTLIER-PAYMENT.                                            08210005
140900***************************************************************   08230005
141000*                    OUTLIER PAYMENT                              08240005
141100***************************************************************   08250005
141200     COMPUTE OUT-THRES-LABOR-ADJ ROUNDED =                        08260005
141300               WIR-CBSA-WAGEIND *                                 08270005
141400               LABOR-PERCENT * OUTLIER-THRESHOLD-AMT.             08280005
141500                                                                  08290005
141600     COMPUTE OUT-THRES-NON-LABOR-ADJ ROUNDED =                    08300005
141700               NONLABOR-PERCENT * OUTLIER-THRESHOLD-AMT.          08310005
141800                                                                  08320005
141900     COMPUTE OUT-THRES-AMT-ADJ ROUNDED  =                         08330005
142000             (OUT-THRES-LABOR-ADJ +                               08340005
142100              OUT-THRES-NON-LABOR-ADJ).                           08350005
142200                                                                  08360005
142300      COMPUTE WK-7000-OUTLIER-VALUE-A ROUNDED =                   08370005
142400              OUT-THRES-AMT-ADJ +                                 08380005
142500             WK-3000-PEP-N-PRETOT-PAY +                           08390005
142600             WK-4000-PEP-Y-PRETOT-PAY +                           08400005
142700             WK-5000-PEP-N-PRETOT-PAY +                           08410005
142800             WK-6000-PEP-Y-PRETOT-PAY.                            08420005
142900                                                                  08430005
143000      PERFORM 8000-ADD-REV-DOLL THRU 8000-EXIT                    08440005
143100                  VARYING CO1 FROM 1 BY 1 UNTIL                   08450005
143200                   CO1 > 6.                                       08460005
143300                                                                  08470005
143400      COMPUTE WK-7000-AB-DIFF ROUNDED =                           08480005
143500              WK-8000-OUTLIER-VALUE-B - WK-7000-OUTLIER-VALUE-A.  08490005
143600****===================                                           08500005
143700      IF WK-7000-AB-DIFF > ZERO                                   08510005
143800         COMPUTE WK-7000-CALC ROUNDED =                           08520005
143900               OUTL-LOSS-SHAR-RATIO-PERCENT * WK-7000-AB-DIFF     08530005
144000                                                                  09070005
144100*** ================== NEW OUTLIER CAP HERE ========              09090005
144200         PERFORM 10000-OUTLIER-CAP-CALC THRU 10000-EXIT           03620005
144300*** ================== NEW OUTLIER CAP HERE ========              09090005
144400                                                                  09070005
144500****===================                                           08500005
144600         COMPUTE H-HHA-OUTLIER-PAYMENT ROUNDED =                  08540005
144700               WK-7000-CALC                                       08550005
144800                                                                  08500005
144900****===================                                           08500005
145000         COMPUTE H-HHA-TOTAL-PAYMENT ROUNDED =                    08560005
145100                (WK-7000-CALC +                                   08570005
145200                 WK-3000-PEP-N-PRETOT-PAY +                       08580005
145300                 WK-4000-PEP-Y-PRETOT-PAY +                       08590005
145400                 WK-5000-PEP-N-PRETOT-PAY +                       08600005
145500                 WK-6000-PEP-Y-PRETOT-PAY)                        08610005
145600                                                                  08500005
145700          PERFORM 9000-WHICH-RTC-OUTLIER THRU 9000-EXIT           08620005
145800      ELSE                                                        08630005
145900         COMPUTE H-HHA-TOTAL-PAYMENT ROUNDED =                    08640005
146000                (WK-3000-PEP-N-PRETOT-PAY +                       08650005
146100                 WK-4000-PEP-Y-PRETOT-PAY +                       08660005
146200                 WK-5000-PEP-N-PRETOT-PAY +                       08670005
146300                 WK-6000-PEP-Y-PRETOT-PAY)                        08680005
146400          PERFORM 9050-WHICH-RTC-NO-OUTLIER THRU 9050-EXIT.       08690005
146500                                                                  08700005
146600                                                                  08710005
146700 7000-EXIT.   EXIT.                                               08720005
146800
146900 8000-ADD-REV-DOLL.                                               08730005
147000                                                                  08740005
147100***************************************************************   08750005
147200*        ADD ALL REVENUE DOLLARS                                  08760005
147300***************************************************************   08770005
147400                                                                  08780005
147500     IF H-HHA-REVENUE-CODE (CO1) = SPACES                         08790005
147600        MOVE 6 TO CO1                                             08800005
147700        GO TO 8000-EXIT.                                          08810005
147800                                                                  08780005
147900     IF H-HHA-REVENUE-QTY-COV-VISITS (CO1) = 0                    08850005
148000        GO TO 8000-EXIT.                                          08810005
148100                                                                  08820005
148200     COMPUTE FED-ADJ ROUNDED =                                    08830005
148300                H-HHA-REVENUE-DOLL-RATE (CO1) *                   08840005
148400                H-HHA-REVENUE-QTY-COV-VISITS (CO1).               08850005
148500                                                                  08860005
148600     COMPUTE FED-LABOR-ADJ ROUNDED =                              08870005
148700               WIR-CBSA-WAGEIND *                                 08880005
148800               LABOR-PERCENT * FED-ADJ.                           08890005
148900                                                                  08900005
149000     COMPUTE FED-NON-LABOR-ADJ ROUNDED =                          08910005
149100               NONLABOR-PERCENT * FED-ADJ.                        08920005
149200                                                                  08930005
149300     COMPUTE WK-8000-OUTLIER-LAB-NLAB ROUNDED =                   08940005
149400           (FED-LABOR-ADJ + FED-NON-LABOR-ADJ).                   08950005
149500                                                                  08960005
149600                                                                  08970005
149700     COMPUTE H-HHA-REVENUE-COST (CO1) ROUNDED =                   08980005
149800               WK-8000-OUTLIER-LAB-NLAB.                          08990005
149900                                                                  09000005
150000     COMPUTE WK-8000-OUTLIER-VALUE-B ROUNDED =                    09010005
150100             WK-8000-OUTLIER-VALUE-B + WK-8000-OUTLIER-LAB-NLAB.  09020005
150200                                                                  09030005
150300 8000-EXIT.   EXIT.                                               09040005
150400                                                                  09050005
150500 9000-WHICH-RTC-OUTLIER.                                          09060005
150600                                                                  09070005
150700      MOVE '01' TO H-HHA-PAY-RTC.                                 09080005
150800      IF WK-RTC-ADJ-IND = 1  MOVE '08' TO H-HHA-PAY-RTC.          09100005
150900      IF WK-RTC-ADJ-IND = 2  MOVE '11' TO H-HHA-PAY-RTC.          09110005
151000      IF WK-RTC-ADJ-IND = 3  MOVE '13' TO H-HHA-PAY-RTC.          09120005
151100      IF WK-RTC-ADJ-IND = 4  MOVE '02' TO H-HHA-PAY-RTC.          09120005
151200                                                                  09130005
151300                                                                  09140005
151400 9000-EXIT.   EXIT.                                               09150005
151500                                                                  09160005
151600 9050-WHICH-RTC-NO-OUTLIER.                                       09170005
151700                                                                  09180005
151800      MOVE '00' TO H-HHA-PAY-RTC.                                 09190005
151900                                                                  09200005
152000      IF WK-RTC-ADJ-IND = 1  MOVE '07' TO H-HHA-PAY-RTC.          09210005
152100      IF WK-RTC-ADJ-IND = 2  MOVE '09' TO H-HHA-PAY-RTC.          09220005
152200      IF WK-RTC-ADJ-IND = 3  MOVE '12' TO H-HHA-PAY-RTC.          09230005
152300                                                                  09240005
152400 9050-EXIT.   EXIT.                                               09260005
152500                                                                  09270005
152600*         YEARCHANGE  2010.3                      ===========**   04500005
152700                                                                  09270005
152800 10000-OUTLIER-CAP-CALC.                                          09170005
152900                                                                  09250005
153000     IF  HHA-PROV-PAYMET-TOTAL = 0                                09250005
153100        GO TO 10000-EXIT.                                         08810005
153200                                                                  09250005
153300     IF  HHA-PROV-OUTLIER-PAY-TOTAL = 0                           09250005
153400        GO TO 10000-EXIT.                                         08810005
153500                                                                  09250005
153600     COMPUTE WK-10000-OUTLIER-POOL-PERCENT ROUNDED =              01990005
153700         HHA-PROV-PAYMET-TOTAL * .1.                              09250005
153800                                                                  09250005
153900     COMPUTE WK-10000-OUTLIER-AVAIL-POOL ROUNDED =                01990005
154000      WK-10000-OUTLIER-POOL-PERCENT - HHA-PROV-OUTLIER-PAY-TOTAL. 09250005
154100                                                                  09250005
154200      COMPUTE WK-10000-OUTLIER-POOL-DIF ROUNDED =                 01990005
154300         WK-10000-OUTLIER-AVAIL-POOL - WK-7000-CALC.              09250005
154400                                                                  09250005
154500      IF WK-10000-OUTLIER-POOL-DIF > 0                            01990005
154600        GO TO 10000-EXIT.                                         08810005
154700                                                                  09250005
154800      IF WK-10000-OUTLIER-POOL-DIF < 0 OR                         01990005
154900         HHA-PROV-OUTLIER-PAY-TOTAL < 0                           09250005
155000        COMPUTE WK-7000-CALC ROUNDED = 0                          09080005
155100        MOVE 4 TO WK-RTC-ADJ-IND.                                 09120005
155200                                                                  09250005
155300*         YEARCHANGE  2010.3                      ===========**   04500005
155400                                                                  09250005
155500 10000-EXIT.   EXIT.                                              09260005
155600                                                                  09270005
155700******        L A S T   S O U R C E   S T A T E M E N T   *****   09280005
